diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index d77ba14030..db53c80ac0 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -39,6 +39,8 @@ jobs: - name: install stack uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 - name: build run: | diff --git a/.github/workflows/ci.md b/.github/workflows/ci.md index 4f0de29bf9..f29ae442d4 100644 --- a/.github/workflows/ci.md +++ b/.github/workflows/ci.md @@ -6,23 +6,8 @@ At a high level, the CI process is: 3. On all platforms, build the `unison-runtime` Racket program save the resulting binaries as build artifacts. ### `env` vars at the top of `CI.yaml`: -Some version numbers that are used during CI: -- `ormolu_version: "0.5.0.1"` -- `racket_version: "8.7"` -- `jit_version: "@unison/internal/releases/0.0.17"` - -Some cached directories: - - `ucm_local_bin` a temp path for caching a built `ucm` - - `jit_src_scheme` a temp path for caching generated jit sources - - `unison-jit-dist` - - `base-codebase` a codebase path for caching a codebase generated by `unison-src/builtin-tests/base.md` - - `unison_src_test_results` a temp path for caching the result of passing tests that depend on `unison-src/`, which includes: - - `round-trip-tests` - - `transcripts` - - `unison-src/builtin-tests/interpreter-tests.md` -`jit_generator_os: ubuntu-20.04` - - afaik, the jit sources are generated in a platform-independent way, so we just choose one platform to generate them on. +These variables pin some dependency versions, set up some directories to cache, etc. Please see the `env` section in [ci.yaml](./ci.yaml) for specifics. ### Cached directories: diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index e0649b5ef5..a9bf5c83e6 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -12,19 +12,26 @@ on: workflow_dispatch: env: - ormolu_version: 0.5.2.0 + ## Some version numbers that are used during CI + ormolu_version: 0.7.2.0 + jit_version: "@unison/internal/releases/0.0.18" + runtime_tests_version: "@unison/runtime-tests/main" + + ## Some cached directories + # a temp path for caching a built `ucm` ucm_local_bin: ucm-local-bin - jit_version: "@unison/internal/releases/0.0.17" + # a temp path for caching generated jit sources jit_src_scheme: unison-jit-src/scheme-libs/racket jit_dist: unison-jit-dist - jit_generator_os: ubuntu-20.04 - runtime_tests_version: "@unison/runtime-tests/main" + # a codebase path for caching a codebase generated by `unison-src/builtin-tests/interpreter-tests.md` runtime_tests_codebase: "~/.cache/unisonlanguage/runtime-tests.unison" - # locations of some files that will indicate whether we need to re-run certain steps transcript_test_results: transcript-test-results interpreter_test_results: interpreter-test-results + ## afaik, the jit sources are generated in a platform-independent way, so we choose one platform to generate them on. + jit_generator_os: ubuntu-20.04 + jobs: ormolu: runs-on: ubuntu-20.04 @@ -102,6 +109,8 @@ jobs: - name: install stack if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 # Build deps, then build local code. Splitting it into two steps just allows us to see how much time each step # takes. @@ -264,6 +273,14 @@ jobs: ${{env.transcripts}} # Fail if any transcripts cause git diffs. git diff --ignore-cr-at-eol --exit-code unison-src/transcripts + - name: docs.to-html + if: steps.cache-transcript-test-results.outputs.cache-hit != 'true' + run: | + ${{env.ucm}} transcript unison-src/transcripts-manual/docs.to-html.md + # Fail if the output or generated docs differ. + git diff --ignore-cr-at-eol --exit-code \ + unison-src/transcripts-manual/docs.to-html.output.md \ + unison-src/transcripts-manual/docs.to-html - name: mark transcripts as passing if: steps.cache-transcript-test-results.outputs.cache-hit != 'true' run: | @@ -411,7 +428,7 @@ jobs: build-jit-binary: name: build jit binary needs: generate-jit-source - uses: ./.github/workflows/ci-build-jit-binary.yaml + uses: ./.github/workflows/ci-build-jit-binary.yaml test-jit: name: test jit diff --git a/.github/workflows/haddocks.yaml b/.github/workflows/haddocks.yaml index 4b9179e562..2fb12dad65 100644 --- a/.github/workflows/haddocks.yaml +++ b/.github/workflows/haddocks.yaml @@ -27,6 +27,8 @@ jobs: - name: install stack uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 - name: build with haddocks working-directory: unison diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index e4e7aa4987..9ee02af326 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -37,4 +37,4 @@ jobs: name: unison authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' - name: build all packages and development shells - run: nix -L build --accept-flake-config --no-link --keep-going '.#build-tools' + run: nix -L build --accept-flake-config --no-link --keep-going '.#all' diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 3c35e9f04f..90c206d045 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -22,6 +22,8 @@ jobs: - name: install stack uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 # One of the transcripts fails if the user's git name hasn't been set. - name: set git user info @@ -36,6 +38,9 @@ jobs: stack exec unison transcript unison-src/transcripts-manual/rewrites.md - name: transcripts run: stack exec transcripts + - name: docs.to-html + run: | + stack exec unison transcript unison-src/transcripts-manual/docs.to-html.md - name: save transcript changes uses: stefanzweifel/git-auto-commit-action@v5 with: diff --git a/.gitignore b/.gitignore index e02fc7f2b2..94b29b69e8 100644 --- a/.gitignore +++ b/.gitignore @@ -1,9 +1,14 @@ # Unison .unison* test-output -transcript-* -scratch.u unisonLocal.zip +*.uc +# Ignore all scratch files... +*.u +# Except those in unison-src +!unison-src/**/*.u +# And integration tests +!unison-cli-integration/integration-tests/IntegrationTests/**/*.u # Auto-generated jit-tests.md @@ -19,6 +24,7 @@ dist-newstyle # GHC *.hie *.prof +*.prof.html /.direnv/ /.envrc diff --git a/.ormolu b/.ormolu new file mode 100644 index 0000000000..fb60d7db30 --- /dev/null +++ b/.ormolu @@ -0,0 +1,4 @@ +infixl 8 ^? +infixr 4 %%~, %~ +infixl 3 <|> +infixl 1 &, <&> diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000000..6002d51193 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,7 @@ +{ + "haskell.toolchain": { + "cabal": "3.10.3.0", + "hls": "2.8.0.0", + "stack": "2.15.7" + } +} diff --git a/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs b/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs index f8f7dc29e0..4085b8d784 100644 --- a/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs +++ b/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs @@ -10,7 +10,7 @@ import U.Codebase.HashTags import Unison.Hashing.V2 qualified as Hashing import Unison.Hashing.V2.Convert2 (convertBranchV3, v2ToH2Branch) -hashBranch :: forall m. Monad m => Branch m -> m BranchHash +hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash hashBranch branch = BranchHash . Hashing.contentHash <$> v2ToH2Branch branch diff --git a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs index 53b4b72473..3ab63459b7 100644 --- a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs +++ b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs @@ -100,7 +100,7 @@ v2ToH2Referent = \case V2Referent.Ref r -> H2.ReferentRef (v2ToH2Reference r) V2Referent.Con r cid -> H2.ReferentCon (v2ToH2Reference r) cid -v2ToH2Branch :: Monad m => V2.Branch m -> m H2.Branch +v2ToH2Branch :: (Monad m) => V2.Branch m -> m H2.Branch v2ToH2Branch V2.Branch {terms, types, patches, children} = do hterms <- traverse sequenceA terms @@ -166,7 +166,7 @@ hashPatchFormatToH2Patch Memory.PatchFull.Patch {termEdits, typeEdits} = V2Referent.Con typeRef conId -> do (H2.ReferentCon (v2ToH2Reference $ second unComponentHash typeRef) conId) -v2ToH2Term :: forall v. Ord v => V2.Term.HashableTerm v -> H2.Term v () +v2ToH2Term :: forall v. (Ord v) => V2.Term.HashableTerm v -> H2.Term v () v2ToH2Term = ABT.transform convertF where convertF :: V2.Term.F' Text V2.Term.HashableTermRef V2.Term.TypeRef V2.Term.HashableTermLink V2.Term.TypeLink v a1 -> H2.TermF v () () a1 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs index afb2a54c26..c2df6ef2f6 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs @@ -173,7 +173,7 @@ decodeWatchResultFormat = ------------------------------------------------------------------------------------------------------------------------ -- unsyncs -unsyncTermComponent :: HasCallStack => TermFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (TermFormat.LocallyIndexedComponent' t d) +unsyncTermComponent :: (HasCallStack) => TermFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (TermFormat.LocallyIndexedComponent' t d) unsyncTermComponent (TermFormat.SyncLocallyIndexedComponent terms) = do let phi (localIds, bs) = do (a, b) <- decodeSyncTermAndType bs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs index 028c4d827f..6c0c264265 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs @@ -39,7 +39,7 @@ data HashHandle = HashHandle toReferenceDecl :: Hash -> C.Type.TypeD Symbol -> C.Reference, -- | Hash decl's mentions toReferenceDeclMentions :: Hash -> C.Type.TypeD Symbol -> Set C.Reference, - hashBranch :: forall m. Monad m => Branch m -> m BranchHash, + hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash, hashBranchV3 :: forall m. BranchV3 m -> BranchHash, hashCausal :: -- The causal's namespace hash diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs index 1cfd697365..d8645b81ae 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs @@ -15,7 +15,7 @@ data LocalIds' t h = LocalIds { textLookup :: Vector t, defnLookup :: Vector h } - deriving (Show) + deriving (Functor, Show) type LocalIds = LocalIds' TextId ObjectId diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs index 74228c5d9b..4319249f4b 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs @@ -109,23 +109,23 @@ localizePatchG (Patch termEdits typeEdits) = -- General-purpose localization -- Contains references to branch objects. -class Ord c => ContainsBranches c s where +class (Ord c) => ContainsBranches c s where branches_ :: Lens' s (Map c LocalBranchChildId) -- Contains references to definition objects i.e. term/decl component objects. -class Ord d => ContainsDefns d s where +class (Ord d) => ContainsDefns d s where defns_ :: Lens' s (Map d LocalDefnId) -- Contains references to objects by their hash. -class Ord h => ContainsHashes h s where +class (Ord h) => ContainsHashes h s where hashes_ :: Lens' s (Map h LocalHashId) -- Contains references to patch objects. -class Ord p => ContainsPatches p s where +class (Ord p) => ContainsPatches p s where patches_ :: Lens' s (Map p LocalPatchObjectId) -- Contains text. -class Ord t => ContainsText t s where +class (Ord t) => ContainsText t s where texts_ :: Lens' s (Map t LocalTextId) -- The inner state of the localization of a branch object. @@ -137,16 +137,16 @@ data LocalizeBranchState t d p c = LocalizeBranchState } deriving (Show, Generic) -instance Ord t => ContainsText t (LocalizeBranchState t d p c) where +instance (Ord t) => ContainsText t (LocalizeBranchState t d p c) where texts_ = field @"texts" -instance Ord d => ContainsDefns d (LocalizeBranchState t d p c) where +instance (Ord d) => ContainsDefns d (LocalizeBranchState t d p c) where defns_ = field @"defns" -instance Ord p => ContainsPatches p (LocalizeBranchState t d p c) where +instance (Ord p) => ContainsPatches p (LocalizeBranchState t d p c) where patches_ = field @"patches" -instance Ord c => ContainsBranches c (LocalizeBranchState t d p c) where +instance (Ord c) => ContainsBranches c (LocalizeBranchState t d p c) where branches_ = field @"branches" -- | Run a computation that localizes a branch object, returning the local ids recorded within. @@ -171,13 +171,13 @@ data LocalizePatchState t h d = LocalizePatchState } deriving (Show, Generic) -instance Ord t => ContainsText t (LocalizePatchState t h d) where +instance (Ord t) => ContainsText t (LocalizePatchState t h d) where texts_ = field @"texts" -instance Ord h => ContainsHashes h (LocalizePatchState t h d) where +instance (Ord h) => ContainsHashes h (LocalizePatchState t h d) where hashes_ = field @"hashes" -instance Ord d => ContainsDefns d (LocalizePatchState t h d) where +instance (Ord d) => ContainsDefns d (LocalizePatchState t h d) where defns_ = field @"defns" -- Run a computation that localizes a patch object, returning the local ids recorded within. diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs index 2528aa177c..1f91746219 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs @@ -58,7 +58,7 @@ instance (FromRow ref) => FromRow (NamedRef ref) where newtype ScopedRow ref = ScopedRow (NamedRef ref) -instance ToRow ref => ToRow (ScopedRow ref) where +instance (ToRow ref) => ToRow (ScopedRow ref) where toRow (ScopedRow (NamedRef {reversedSegments = revSegments, ref})) = SQLText reversedName : SQLText namespace : SQLText lastNameSegment : toRow ref where diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index b402620333..5c4e083616 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -1,10 +1,5 @@ module U.Codebase.Sqlite.Operations ( -- * branches - saveRootBranch, - loadRootCausalHash, - expectRootCausalHash, - expectRootCausal, - expectRootBranchHash, loadCausalHashAtPath, expectCausalHashAtPath, loadCausalBranchAtPath, @@ -13,6 +8,7 @@ module U.Codebase.Sqlite.Operations saveBranchV3, loadCausalBranchByCausalHash, expectCausalBranchByCausalHash, + expectBranchByCausalHashId, expectBranchByBranchHash, expectBranchByBranchHashId, expectNamespaceStatsByHash, @@ -63,9 +59,11 @@ module U.Codebase.Sqlite.Operations causalHashesByPrefix, -- ** dependents index + directDependenciesOfScope, dependents, dependentsOfComponent, - dependentsWithinScope, + directDependentsWithinScope, + transitiveDependentsWithinScope, -- ** type index Q.addTypeToIndexForTerm, @@ -98,9 +96,16 @@ module U.Codebase.Sqlite.Operations fuzzySearchDefinitions, namesPerspectiveForRootAndPath, + -- * Projects + expectProjectAndBranchNames, + expectProjectBranchHead, + -- * reflog - getReflog, - appendReflog, + getDeprecatedRootReflog, + getProjectReflog, + getProjectBranchReflog, + getGlobalReflog, + appendProjectReflog, -- * low-level stuff expectDbBranch, @@ -181,6 +186,9 @@ import U.Codebase.Sqlite.Patch.TermEdit qualified as S import U.Codebase.Sqlite.Patch.TermEdit qualified as S.TermEdit import U.Codebase.Sqlite.Patch.TypeEdit qualified as S import U.Codebase.Sqlite.Patch.TypeEdit qualified as S.TypeEdit +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Reference qualified as S import U.Codebase.Sqlite.Reference qualified as S.Reference @@ -198,6 +206,7 @@ import U.Codebase.TypeEdit qualified as C.TypeEdit import U.Codebase.WatchKind (WatchKind) import U.Util.Base32Hex qualified as Base32Hex import U.Util.Serialization qualified as S +import Unison.Core.Project (ProjectBranchName, ProjectName) import Unison.Hash qualified as H import Unison.Hash32 qualified as Hash32 import Unison.NameSegment (NameSegment) @@ -205,6 +214,7 @@ import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortCausalHash (..), ShortNamespaceHash (..)) import Unison.Sqlite +import Unison.Util.Defns (DefnsF) import Unison.Util.List qualified as List import Unison.Util.Map qualified as Map import Unison.Util.Monoid (foldMapM) @@ -229,23 +239,10 @@ expectValueHashByCausalHashId = loadValueHashById <=< Q.expectCausalValueHashId loadValueHashById :: Db.BranchHashId -> Transaction BranchHash loadValueHashById = fmap BranchHash . Q.expectHash . Db.unBranchHashId -expectRootCausalHash :: Transaction CausalHash -expectRootCausalHash = Q.expectCausalHash =<< Q.expectNamespaceRoot - -expectRootBranchHash :: Transaction BranchHash -expectRootBranchHash = do - rootCausalHashId <- Q.expectNamespaceRoot - expectValueHashByCausalHashId rootCausalHashId - -loadRootCausalHash :: Transaction (Maybe CausalHash) -loadRootCausalHash = - runMaybeT $ - lift . Q.expectCausalHash =<< MaybeT Q.loadNamespaceRoot - -- | Load the causal hash at the given path from the provided root, if Nothing, use the -- codebase root. -loadCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash) -loadCausalHashAtPath mayRootCausalHash = +loadCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash) +loadCausalHashAtPath rootCausalHash = let go :: Db.CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash go hashId = \case [] -> lift (Q.expectCausalHash hashId) @@ -255,15 +252,13 @@ loadCausalHashAtPath mayRootCausalHash = (_, hashId') <- MaybeT (pure (Map.lookup tid children)) go hashId' ts in \path -> do - hashId <- case mayRootCausalHash of - Nothing -> Q.expectNamespaceRoot - Just rootCH -> Q.expectCausalHashIdByCausalHash rootCH + hashId <- Q.expectCausalHashIdByCausalHash rootCausalHash runMaybeT (go hashId path) -- | Expect the causal hash at the given path from the provided root, if Nothing, use the -- codebase root. -expectCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction CausalHash -expectCausalHashAtPath mayRootCausalHash = +expectCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction CausalHash +expectCausalHashAtPath rootCausalHash = let go :: Db.CausalHashId -> [NameSegment] -> Transaction CausalHash go hashId = \case [] -> Q.expectCausalHash hashId @@ -273,23 +268,21 @@ expectCausalHashAtPath mayRootCausalHash = let (_, hashId') = children Map.! tid go hashId' ts in \path -> do - hashId <- case mayRootCausalHash of - Nothing -> Q.expectNamespaceRoot - Just rootCH -> Q.expectCausalHashIdByCausalHash rootCH + hashId <- Q.expectCausalHashIdByCausalHash rootCausalHash go hashId path loadCausalBranchAtPath :: - Maybe CausalHash -> + CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.CausalBranch Transaction)) -loadCausalBranchAtPath maybeRootCausalHash path = - loadCausalHashAtPath maybeRootCausalHash path >>= \case +loadCausalBranchAtPath rootCausalHash path = + loadCausalHashAtPath rootCausalHash path >>= \case Nothing -> pure Nothing Just causalHash -> Just <$> expectCausalBranchByCausalHash causalHash -loadBranchAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.Branch Transaction)) -loadBranchAtPath maybeRootCausalHash path = - loadCausalBranchAtPath maybeRootCausalHash path >>= \case +loadBranchAtPath :: CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.Branch Transaction)) +loadBranchAtPath rootCausalHash path = + loadCausalBranchAtPath rootCausalHash path >>= \case Nothing -> pure Nothing Just causal -> Just <$> C.Causal.value causal @@ -610,16 +603,6 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) = boId <- Q.expectBranchObjectIdByCausalHashId chId expectBranch boId -saveRootBranch :: - HashHandle -> - C.Branch.CausalBranch Transaction -> - Transaction (Db.BranchObjectId, Db.CausalHashId) -saveRootBranch hh c = do - when debug $ traceM $ "Operations.saveRootBranch " ++ show (C.causalHash c) - (boId, chId) <- saveBranch hh c - Q.setNamespaceRoot chId - pure (boId, chId) - -- saveBranch is kind of a "deep save causal" -- we want a "shallow save causal" that could take a @@ -746,9 +729,6 @@ saveCausalObject hh (C.Causal.Causal hc he parents _) = do Q.saveCausal hh chId bhId parentCausalHashIds pure (chId, bhId) -expectRootCausal :: Transaction (C.Branch.CausalBranch Transaction) -expectRootCausal = Q.expectNamespaceRoot >>= expectCausalBranchByCausalHashId - loadCausalBranchByCausalHash :: CausalHash -> Transaction (Maybe (C.Branch.CausalBranch Transaction)) loadCausalBranchByCausalHash hc = do Q.loadCausalHashIdByCausalHash hc >>= \case @@ -1121,6 +1101,21 @@ causalHashesByPrefix (ShortCausalHash b32prefix) = do hashes <- traverse (Q.expectHash . Db.unCausalHashId) hashIds pure $ Set.fromList . map CausalHash $ hashes +directDependenciesOfScope :: + DefnsF Set C.TermReferenceId C.TypeReferenceId -> + Transaction (DefnsF Set C.TermReference C.TypeReference) +directDependenciesOfScope scope0 = do + -- Convert C -> S + scope1 <- bitraverse (Set.traverse c2sReferenceId) (Set.traverse c2sReferenceId) scope0 + + -- Do the query + dependencies0 <- Q.getDirectDependenciesOfScope scope1 + + -- Convert S -> C + dependencies1 <- bitraverse (Set.traverse s2cReference) (Set.traverse s2cReference) dependencies0 + + pure dependencies1 + -- | returns a list of known definitions referencing `r` dependents :: Q.DependentsSelector -> C.Reference -> Transaction (Set C.Reference.Id) dependents selector r = do @@ -1137,19 +1132,43 @@ dependents selector r = do sIds <- Q.getDependentsForDependency selector r' Set.traverse s2cReferenceId sIds --- | `dependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not --- including `query` itself). Each dependent is also tagged with whether it is a term or decl. -dependentsWithinScope :: Set C.Reference.Id -> Set C.Reference -> Transaction (Map C.Reference.Id C.ReferenceType) -dependentsWithinScope scope query = do - scope' <- Set.traverse c2sReferenceId scope - query' <- Set.traverse c2sReference query - Q.getDependentsWithinScope scope' query' - >>= Map.bitraverse s2cReferenceId (pure . objectTypeToReferenceType) - where - objectTypeToReferenceType = \case - ObjectType.TermComponent -> C.RtTerm - ObjectType.DeclComponent -> C.RtType - _ -> error "Q.getDependentsWithinScope shouldn't return any other types" +-- | `directDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not +-- including `query` itself). +directDependentsWithinScope :: + Set C.Reference.Id -> + Set C.Reference -> + Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId) +directDependentsWithinScope scope0 query0 = do + -- Convert C -> S + scope1 <- Set.traverse c2sReferenceId scope0 + query1 <- Set.traverse c2sReference query0 + + -- Do the query + dependents0 <- Q.getDirectDependentsWithinScope scope1 query1 + + -- Convert S -> C + dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0 + + pure dependents1 + +-- | `transitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope` (not +-- including `query` itself). +transitiveDependentsWithinScope :: + Set C.Reference.Id -> + Set C.Reference -> + Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId) +transitiveDependentsWithinScope scope0 query0 = do + -- Convert C -> S + scope1 <- Set.traverse c2sReferenceId scope0 + query1 <- Set.traverse c2sReference query0 + + -- Do the query + dependents0 <- Q.getTransitiveDependentsWithinScope scope1 query1 + + -- Convert S -> C + dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0 + + pure dependents1 -- | returns a list of known definitions referencing `h` dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id) @@ -1468,15 +1487,43 @@ namespaceStatsForDbBranch = \case expectNamespaceStatsByHashId bhId -- | Gets the specified number of reflog entries in chronological order, most recent first. -getReflog :: Int -> Transaction [Reflog.Entry CausalHash Text] -getReflog numEntries = do - entries <- Q.getReflog numEntries +getDeprecatedRootReflog :: Int -> Transaction [Reflog.Entry CausalHash Text] +getDeprecatedRootReflog numEntries = do + entries <- Q.getDeprecatedRootReflog numEntries traverse (bitraverse Q.expectCausalHash pure) entries -appendReflog :: Reflog.Entry CausalHash Text -> Transaction () -appendReflog entry = do - dbEntry <- (bitraverse Q.saveCausalHash pure) entry - Q.appendReflog dbEntry +-- | Gets the specified number of reflog entries for the given project in chronological order, most recent first. +getProjectReflog :: Int -> Db.ProjectId -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash] +getProjectReflog numEntries projectId = do + entries <- Q.getProjectReflog numEntries projectId + traverse hydrateProjectReflogEntry entries + +-- | Gets the specified number of reflog entries for the specified ProjectBranch in chronological order, most recent first. +getProjectBranchReflog :: Int -> Db.ProjectBranchId -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash] +getProjectBranchReflog numEntries projectBranchId = do + entries <- Q.getProjectBranchReflog numEntries projectBranchId + traverse hydrateProjectReflogEntry entries + +-- | Gets the specified number of reflog entries in chronological order, most recent first. +getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash] +getGlobalReflog numEntries = do + entries <- Q.getGlobalReflog numEntries + traverse hydrateProjectReflogEntry entries + +hydrateProjectReflogEntry :: ProjectReflog.Entry Db.ProjectId Db.ProjectBranchId Db.CausalHashId -> Transaction (ProjectReflog.Entry Project ProjectBranch CausalHash) +hydrateProjectReflogEntry entry = do + traverse Q.expectCausalHash entry + >>= ProjectReflog.projectAndBranch_ + %%~ ( \(projId, branchId) -> do + proj <- Q.expectProject projId + branch <- Q.expectProjectBranch projId branchId + pure (proj, branch) + ) + +appendProjectReflog :: ProjectReflog.Entry Db.ProjectId Db.ProjectBranchId CausalHash -> Transaction () +appendProjectReflog entry = do + dbEntry <- traverse Q.saveCausalHash entry + Q.appendProjectBranchReflog dbEntry -- | Delete any name lookup that's not in the provided list. -- @@ -1542,3 +1589,14 @@ stripPrefixFromNamedRef (PathSegments prefix) namedRef = Nothing -> reversedName Just strippedReversedPath -> S.ReversedName (name NonEmpty.:| strippedReversedPath) in namedRef {S.reversedSegments = newReversedName} + +expectProjectAndBranchNames :: Db.ProjectId -> Db.ProjectBranchId -> Transaction (ProjectName, ProjectBranchName) +expectProjectAndBranchNames projectId projectBranchId = do + Project {name = pName} <- Q.expectProject projectId + ProjectBranch {name = bName} <- Q.expectProjectBranch projectId projectBranchId + pure (pName, bName) + +expectProjectBranchHead :: Db.ProjectId -> Db.ProjectBranchId -> Transaction CausalHash +expectProjectBranchHead projId projectBranchId = do + chId <- Q.expectProjectBranchHead projId projectBranchId + Q.expectCausalHash chId diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs index b2f1366932..749a87290c 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs @@ -55,7 +55,7 @@ patchT_ f Patch {termEdits, typeEdits} = do newTypeEdits <- traverseOf (Map.bitraversed (Reference.t_) (Set.traverse . traverseFirst)) f typeEdits pure Patch {termEdits = newTermEdits, typeEdits = newTypeEdits} where - traverseFirst :: Bitraversable b => Traversal (b a c) (b a' c) a a' + traverseFirst :: (Bitraversable b) => Traversal (b a c) (b a' c) a a' traverseFirst f = bitraverse f pure patchH_ :: (Ord t, Ord h') => Traversal (Patch' t h o) (Patch' t h' o) h h' diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs index bc93dd166c..e588dc7540 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs @@ -22,6 +22,12 @@ type Referent' t h = Referent.Referent' (Reference' t h) (Reference' t h) data TermEdit' t h = Replace (Referent' t h) Typing | Deprecate deriving (Eq, Ord, Show) +instance Functor (TermEdit' t) where + fmap :: (a -> b) -> TermEdit' t a -> TermEdit' t b + fmap f (Replace (Referent.Ref termRef) typing) = Replace (Referent.Ref (fmap f termRef)) typing + fmap f (Replace (Referent.Con typeRef consId) typing) = Replace (Referent.Con (fmap f typeRef) consId) typing + fmap _ Deprecate = Deprecate + _Replace :: Prism (TermEdit' t h) (TermEdit' t' h') (Referent' t h, Typing) (Referent' t' h', Typing) _Replace = prism embed project where diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs index 6b8d3ea48c..ae0816b6b9 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs @@ -17,7 +17,7 @@ type TypeEdit = TypeEdit' Db.TextId Db.ObjectId type HashTypeEdit = TypeEdit' Text ComponentHash data TypeEdit' t h = Replace (Reference' t h) | Deprecate - deriving (Eq, Ord, Show) + deriving (Eq, Functor, Ord, Show) _Replace :: Prism (TypeEdit' t h) (TypeEdit' t' h') (Reference' t h) (Reference' t' h') _Replace = prism Replace project diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs index 2707e09c74..94e90b5c00 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs @@ -14,5 +14,5 @@ data Project = Project { projectId :: !ProjectId, name :: !ProjectName } - deriving stock (Generic, Show) + deriving stock (Generic, Show, Eq) deriving anyclass (ToRow, FromRow) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs new file mode 100644 index 0000000000..b759df2586 --- /dev/null +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +module U.Codebase.Sqlite.ProjectReflog + ( Entry (..), + project_, + branch_, + projectAndBranch_, + ) +where + +import Control.Lens +import Data.Text (Text) +import Data.Time (UTCTime) +import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId, ProjectId) +import Unison.Sqlite (FromRow (..), ToRow (..), field) + +data Entry project branch causal = Entry + { project :: project, + branch :: branch, + time :: UTCTime, + fromRootCausalHash :: Maybe causal, + toRootCausalHash :: causal, + reason :: Text + } + deriving stock (Eq, Show, Functor, Foldable, Traversable) + +project_ :: Lens (Entry project branch causal) (Entry project' branch causal) project project' +project_ = lens project (\e p -> e {project = p}) + +branch_ :: Lens (Entry project branch causal) (Entry project branch' causal) branch branch' +branch_ = lens branch (\e b -> e {branch = b}) + +-- | Both Project and Branch Ids are required to load a branch, so this is often more useful. +projectAndBranch_ :: Lens (Entry project branch causal) (Entry project' branch' causal) (project, branch) (project', branch') +projectAndBranch_ = lens (\Entry {..} -> (project, branch)) (\e (project, branch) -> e {project = project, branch = branch}) + +instance ToRow (Entry ProjectId ProjectBranchId CausalHashId) where + toRow (Entry proj branch time fromRootCausalHash toRootCausalHash reason) = + toRow (proj, branch, time, fromRootCausalHash, toRootCausalHash, reason) + +instance FromRow (Entry ProjectId ProjectBranchId CausalHashId) where + fromRow = do + project <- field + branch <- field + time <- field + fromRootCausalHash <- field + toRootCausalHash <- field + reason <- field + pure $ Entry {..} diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 880d3cdf04..822cdd125e 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -66,12 +66,6 @@ module U.Codebase.Sqlite.Queries loadTermObject, expectTermObject, - -- * namespace_root table - loadNamespaceRoot, - setNamespaceRoot, - expectNamespaceRoot, - expectNamespaceRootBranchHashId, - -- * namespace_statistics table saveNamespaceStats, loadNamespaceStatsByHashId, @@ -135,6 +129,8 @@ module U.Codebase.Sqlite.Queries insertProjectBranch, renameProjectBranch, deleteProjectBranch, + setProjectBranchHead, + expectProjectBranchHead, setMostRecentBranch, loadMostRecentBranch, @@ -165,7 +161,9 @@ module U.Codebase.Sqlite.Queries getDependenciesForDependent, getDependencyIdsForDependent, getDependenciesBetweenTerms, - getDependentsWithinScope, + getDirectDependenciesOfScope, + getDirectDependentsWithinScope, + getTransitiveDependentsWithinScope, -- ** type index addToTypeIndex, @@ -213,8 +211,11 @@ module U.Codebase.Sqlite.Queries fuzzySearchTypes, -- * Reflog - appendReflog, - getReflog, + getDeprecatedRootReflog, + appendProjectBranchReflog, + getProjectReflog, + getProjectBranchReflog, + getGlobalReflog, -- * garbage collection garbageCollectObjectsWithoutHashes, @@ -235,12 +236,12 @@ module U.Codebase.Sqlite.Queries -- * elaborate hashes elaborateHashes, - -- * most recent namespace - expectMostRecentNamespace, - setMostRecentNamespace, + -- * current project path + expectCurrentProjectPath, + setCurrentProjectPath, -- * migrations - createSchema, + runCreateSql, addTempEntityTables, addReflogTable, addNamespaceStatsTables, @@ -252,6 +253,9 @@ module U.Codebase.Sqlite.Queries addSquashResultTable, addSquashResultTableIfNotExists, cdToProjectRoot, + addCurrentProjectPathTable, + addProjectBranchReflogTable, + addProjectBranchCausalHashIdColumn, -- ** schema version currentSchemaVersion, @@ -285,6 +289,7 @@ module U.Codebase.Sqlite.Queries -- * Types NamespaceText, TextPathSegments, + JsonParseFailure (..), ) where @@ -313,6 +318,7 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.Lazy qualified as Text.Lazy +import Data.Time qualified as Time import Data.Vector qualified as Vector import GHC.Stack (callStack) import Network.URI (URI) @@ -321,7 +327,7 @@ import U.Codebase.Decl qualified as C import U.Codebase.Decl qualified as C.Decl import U.Codebase.HashTags (BranchHash (..), CausalHash (..), PatchHash (..)) import U.Codebase.Reference (Reference' (..)) -import U.Codebase.Reference qualified as C +import U.Codebase.Reference qualified as C (Reference) import U.Codebase.Reference qualified as C.Reference import U.Codebase.Referent qualified as C.Referent import U.Codebase.Reflog qualified as Reflog @@ -365,10 +371,10 @@ import U.Codebase.Sqlite.Orphans () import U.Codebase.Sqlite.Patch.Format qualified as PatchFormat import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) -import U.Codebase.Sqlite.Reference qualified as Reference +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import U.Codebase.Sqlite.Reference qualified as S import U.Codebase.Sqlite.Reference qualified as S.Reference -import U.Codebase.Sqlite.Referent qualified as Referent +import U.Codebase.Sqlite.Referent qualified as S (TextReferent) import U.Codebase.Sqlite.Referent qualified as S.Referent import U.Codebase.Sqlite.RemoteProject (RemoteProject (..)) import U.Codebase.Sqlite.RemoteProjectBranch (RemoteProjectBranch) @@ -398,7 +404,9 @@ import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Sqlite +import Unison.Sqlite qualified as Sqlite import Unison.Util.Alternative qualified as Alternative +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.FileEmbed (embedProjectStringFile) import Unison.Util.Lens qualified as Lens import Unison.Util.Map qualified as Map @@ -412,27 +420,11 @@ type TextPathSegments = [Text] -- * main squeeze currentSchemaVersion :: SchemaVersion -currentSchemaVersion = 16 +currentSchemaVersion = 17 -createSchema :: Transaction () -createSchema = do +runCreateSql :: Transaction () +runCreateSql = executeStatements $(embedProjectStringFile "sql/create.sql") - addTempEntityTables - addNamespaceStatsTables - addReflogTable - fixScopedNameLookupTables - addProjectTables - addMostRecentBranchTable - addNameLookupMountTables - addMostRecentNamespaceTable - execute insertSchemaVersionSql - addSquashResultTable - where - insertSchemaVersionSql = - [sql| - INSERT INTO schema_version (version) - VALUES (:currentSchemaVersion) - |] addTempEntityTables :: Transaction () addTempEntityTables = @@ -442,6 +434,7 @@ addNamespaceStatsTables :: Transaction () addNamespaceStatsTables = executeStatements $(embedProjectStringFile "sql/003-namespace-statistics.sql") +-- | Deprecated in favour of project-branch reflog addReflogTable :: Transaction () addReflogTable = executeStatements $(embedProjectStringFile "sql/002-reflog-table.sql") @@ -480,6 +473,19 @@ cdToProjectRoot :: Transaction () cdToProjectRoot = executeStatements $(embedProjectStringFile "sql/011-cd-to-project-root.sql") +addCurrentProjectPathTable :: Transaction () +addCurrentProjectPathTable = + executeStatements $(embedProjectStringFile "sql/012-add-current-project-path-table.sql") + +-- | Deprecated in favour of project-branch reflog +addProjectBranchReflogTable :: Transaction () +addProjectBranchReflogTable = + executeStatements $(embedProjectStringFile "sql/013-add-project-branch-reflog-table.sql") + +addProjectBranchCausalHashIdColumn :: Transaction () +addProjectBranchCausalHashIdColumn = + executeStatements $(embedProjectStringFile "sql/014-add-project-branch-causal-hash-id.sql") + schemaVersion :: Transaction SchemaVersion schemaVersion = queryOneCol @@ -1335,33 +1341,7 @@ loadCausalParentsByHash hash = WHERE h1.base32 = :hash COLLATE NOCASE |] -expectNamespaceRootBranchHashId :: Transaction BranchHashId -expectNamespaceRootBranchHashId = do - chId <- expectNamespaceRoot - expectCausalValueHashId chId - -expectNamespaceRoot :: Transaction CausalHashId -expectNamespaceRoot = - queryOneCol loadNamespaceRootSql - -loadNamespaceRoot :: Transaction (Maybe CausalHashId) -loadNamespaceRoot = - queryMaybeCol loadNamespaceRootSql - -loadNamespaceRootSql :: Sql -loadNamespaceRootSql = - [sql| - SELECT causal_id - FROM namespace_root - |] - -setNamespaceRoot :: CausalHashId -> Transaction () -setNamespaceRoot id = - queryOneCol [sql| SELECT EXISTS (SELECT 1 FROM namespace_root) |] >>= \case - False -> execute [sql| INSERT INTO namespace_root VALUES (:id) |] - True -> execute [sql| UPDATE namespace_root SET causal_id = :id |] - -saveWatch :: WatchKind -> Reference.IdH -> ByteString -> Transaction () +saveWatch :: WatchKind -> S.Reference.IdH -> ByteString -> Transaction () saveWatch k r blob = do execute [sql| @@ -1379,7 +1359,7 @@ saveWatch k r blob = do loadWatch :: SqliteExceptionReason e => WatchKind -> - Reference.IdH -> + S.Reference.IdH -> (ByteString -> Either e a) -> Transaction (Maybe a) loadWatch k r check = @@ -1395,7 +1375,7 @@ loadWatch k r check = |] check -loadWatchKindsByReference :: Reference.IdH -> Transaction [WatchKind] +loadWatchKindsByReference :: S.Reference.IdH -> Transaction [WatchKind] loadWatchKindsByReference r = queryListCol [sql| @@ -1407,7 +1387,7 @@ loadWatchKindsByReference r = AND watch.component_index = @ |] -loadWatchesByWatchKind :: WatchKind -> Transaction [Reference.IdH] +loadWatchesByWatchKind :: WatchKind -> Transaction [S.Reference.IdH] loadWatchesByWatchKind k = queryListRow [sql| @@ -1423,7 +1403,7 @@ clearWatches = do execute [sql| DELETE FROM watch |] -- * Index-building -addToTypeIndex :: Reference' TextId HashId -> Referent.Id -> Transaction () +addToTypeIndex :: S.ReferenceH -> S.Referent.Id -> Transaction () addToTypeIndex tp tm = execute [sql| @@ -1438,7 +1418,7 @@ addToTypeIndex tp tm = ON CONFLICT DO NOTHING |] -getReferentsByType :: Reference' TextId HashId -> Transaction [Referent.Id] +getReferentsByType :: S.ReferenceH -> Transaction [S.Referent.Id] getReferentsByType r = queryListRow [sql| @@ -1452,7 +1432,7 @@ getReferentsByType r = AND type_reference_component_index IS @ |] -getTypeReferenceForReferent :: Referent.Id -> Transaction (Reference' TextId HashId) +getTypeReferenceForReferent :: S.Referent.Id -> Transaction S.ReferenceH getTypeReferenceForReferent r = queryOneRow [sql| @@ -1467,7 +1447,7 @@ getTypeReferenceForReferent r = |] -- todo: error if no results -getTypeReferencesForComponent :: ObjectId -> Transaction [(Reference' TextId HashId, Referent.Id)] +getTypeReferencesForComponent :: ObjectId -> Transaction [(S.ReferenceH, S.Referent.Id)] getTypeReferencesForComponent oId = fmap (map fixupTypeIndexRow) $ queryListRow @@ -1553,7 +1533,7 @@ filterTermsByReferenceHavingType typ terms = create *> for_ terms insert *> sele drop = execute [sql|DROP TABLE filter_query|] -addToTypeMentionsIndex :: Reference' TextId HashId -> Referent.Id -> Transaction () +addToTypeMentionsIndex :: S.ReferenceH -> S.Referent.Id -> Transaction () addToTypeMentionsIndex tp tm = execute [sql| @@ -1568,7 +1548,7 @@ addToTypeMentionsIndex tp tm = ON CONFLICT DO NOTHING |] -getReferentsByTypeMention :: Reference' TextId HashId -> Transaction [Referent.Id] +getReferentsByTypeMention :: S.ReferenceH -> Transaction [S.Referent.Id] getReferentsByTypeMention r = queryListRow [sql| @@ -1583,7 +1563,7 @@ getReferentsByTypeMention r = |] -- todo: error if no results -getTypeMentionsReferencesForComponent :: ObjectId -> Transaction [(Reference' TextId HashId, Referent.Id)] +getTypeMentionsReferencesForComponent :: ObjectId -> Transaction [(S.ReferenceH, S.Referent.Id)] getTypeMentionsReferencesForComponent r = fmap (map fixupTypeIndexRow) $ queryListRow @@ -1599,7 +1579,7 @@ getTypeMentionsReferencesForComponent r = WHERE term_referent_object_id IS :r |] -fixupTypeIndexRow :: Reference' TextId HashId :. Referent.Id -> (Reference' TextId HashId, Referent.Id) +fixupTypeIndexRow :: S.ReferenceH :. S.Referent.Id -> (S.ReferenceH, S.Referent.Id) fixupTypeIndexRow (rh :. ri) = (rh, ri) -- | Delete objects without hashes. An object typically *would* have a hash, but (for example) during a migration in which an object's hash @@ -1653,7 +1633,7 @@ garbageCollectWatchesWithoutObjects = do (SELECT hash_object.hash_id FROM hash_object) |] -addToDependentsIndex :: [Reference.Reference] -> Reference.Id -> Transaction () +addToDependentsIndex :: [S.Reference] -> S.Reference.Id -> Transaction () addToDependentsIndex dependencies dependent = for_ dependencies \dependency -> execute @@ -1682,7 +1662,7 @@ data DependentsSelector | ExcludeOwnComponent -- | Get dependents of a dependency. -getDependentsForDependency :: DependentsSelector -> Reference.Reference -> Transaction (Set Reference.Id) +getDependentsForDependency :: DependentsSelector -> S.Reference -> Transaction (Set S.Reference.Id) getDependentsForDependency selector dependency = do dependents <- queryListRow @@ -1699,19 +1679,19 @@ getDependentsForDependency selector dependency = do ExcludeSelf -> filter isNotSelfReference dependents ExcludeOwnComponent -> filter isNotReferenceFromOwnComponent dependents where - isNotReferenceFromOwnComponent :: Reference.Id -> Bool + isNotReferenceFromOwnComponent :: S.Reference.Id -> Bool isNotReferenceFromOwnComponent = case dependency of ReferenceBuiltin _ -> const True ReferenceDerived (C.Reference.Id oid0 _pos0) -> \(C.Reference.Id oid1 _pos1) -> oid0 /= oid1 - isNotSelfReference :: Reference.Id -> Bool + isNotSelfReference :: S.Reference.Id -> Bool isNotSelfReference = case dependency of ReferenceBuiltin _ -> const True ReferenceDerived ref -> (ref /=) -getDependentsForDependencyComponent :: ObjectId -> Transaction [Reference.Id] +getDependentsForDependencyComponent :: ObjectId -> Transaction [S.Reference.Id] getDependentsForDependencyComponent dependency = filter isNotSelfReference <$> queryListRow @@ -1722,12 +1702,12 @@ getDependentsForDependencyComponent dependency = AND dependency_object_id IS :dependency |] where - isNotSelfReference :: Reference.Id -> Bool + isNotSelfReference :: S.Reference.Id -> Bool isNotSelfReference = \case (C.Reference.Id oid1 _pos1) -> dependency /= oid1 -- | Get non-self dependencies of a user-defined dependent. -getDependenciesForDependent :: Reference.Id -> Transaction [Reference.Reference] +getDependenciesForDependent :: S.Reference.Id -> Transaction [S.Reference] getDependenciesForDependent dependent@(C.Reference.Id oid0 _) = fmap (filter isNotSelfReference) $ queryListRow @@ -1738,13 +1718,13 @@ getDependenciesForDependent dependent@(C.Reference.Id oid0 _) = AND dependent_component_index IS @ |] where - isNotSelfReference :: Reference.Reference -> Bool + isNotSelfReference :: S.Reference -> Bool isNotSelfReference = \case ReferenceBuiltin _ -> True ReferenceDerived (C.Reference.Id oid1 _) -> oid0 /= oid1 -- | Get non-self, user-defined dependencies of a user-defined dependent. -getDependencyIdsForDependent :: Reference.Id -> Transaction [Reference.Id] +getDependencyIdsForDependent :: S.Reference.Id -> Transaction [S.Reference.Id] getDependencyIdsForDependent dependent@(C.Reference.Id oid0 _) = fmap (filter isNotSelfReference) $ queryListRow @@ -1756,7 +1736,7 @@ getDependencyIdsForDependent dependent@(C.Reference.Id oid0 _) = AND dependent_component_index = @ |] where - isNotSelfReference :: Reference.Id -> Bool + isNotSelfReference :: S.Reference.Id -> Bool isNotSelfReference (C.Reference.Id oid1 _) = oid0 /= oid1 @@ -1869,35 +1849,111 @@ getDependenciesBetweenTerms oid1 oid2 = WHERE path_elem IS NOT null |] --- | `getDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not --- including `query` itself). Each dependent is also tagged with whether it is a term or decl. -getDependentsWithinScope :: Set Reference.Id -> Set S.Reference -> Transaction (Map Reference.Id ObjectType) -getDependentsWithinScope scope query = do +-- Mitchell says: why are we enabling and disabling ormolu all over this file? Let's just enable. But right now I'm only +-- adding this one query and don't want a big diff in my PR. + +{- ORMOLU_ENABLE -} + +getDirectDependenciesOfScope :: + DefnsF Set S.TermReferenceId S.TypeReferenceId -> + Transaction (DefnsF Set S.TermReference S.TypeReference) +getDirectDependenciesOfScope scope = do + let tempTableName = [sql| temp_dependents |] + -- Populate a temporary table with all of the references in `scope` - execute - [sql| - CREATE TEMPORARY TABLE dependents_search_scope ( - dependent_object_id INTEGER NOT NULL, - dependent_component_index INTEGER NOT NULL, - PRIMARY KEY (dependent_object_id, dependent_component_index) - ) - |] - for_ scope \r -> - execute [sql|INSERT INTO dependents_search_scope VALUES (@r, @)|] + createTemporaryTableOfReferenceIds tempTableName (Set.union scope.terms scope.types) + + -- Get their direct dependencies (tagged with object type) + dependencies0 <- + queryListRow @(S.Reference :. Only ObjectType) + [sql| + SELECT d.dependency_builtin, d.dependency_object_id, d.dependency_component_index, o.type_id + FROM dependents_index d + JOIN object o ON d.dependency_object_id = o.id + WHERE (d.dependent_object_id, d.dependent_component_index) IN ( + SELECT object_id, component_index + FROM $tempTableName + ) + |] + + -- Drop the temporary table + execute [sql| DROP TABLE $tempTableName |] + + -- Post-process the query result + let dependencies1 = + List.foldl' + ( \deps -> \case + dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types + dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types) + _ -> deps -- impossible; could error here + ) + (Defns Set.empty Set.empty) + dependencies0 + + pure dependencies1 + +-- | `getDirectDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not +-- including `query` itself). +getDirectDependentsWithinScope :: + Set S.Reference.Id -> + Set S.Reference -> + Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId) +getDirectDependentsWithinScope scope query = do + -- Populate a temporary table with all of the references in `scope` + let scopeTableName = [sql| dependents_search_scope |] + createTemporaryTableOfReferenceIds scopeTableName scope -- Populate a temporary table with all of the references in `query` - execute - [sql| - CREATE TEMPORARY TABLE dependencies_query ( - dependency_builtin INTEGER NULL, - dependency_object_id INTEGER NULL, - dependency_component_index INTEGER NULL, - CHECK ((dependency_builtin IS NULL) = (dependency_object_id IS NOT NULL)), - CHECK ((dependency_object_id IS NULL) = (dependency_component_index IS NULL)) - ) - |] - for_ query \r -> - execute [sql|INSERT INTO dependencies_query VALUES (@r, @, @)|] + let queryTableName = [sql| dependencies_query |] + createTemporaryTableOfReferences queryTableName query + + -- Get their direct dependents (tagged with object type) + dependents0 <- + queryListRow @(S.Reference.Id :. Only ObjectType) + [sql| + SELECT s.object_id, s.component_index, o.type_id + FROM $queryTableName q + JOIN dependents_index d + ON q.builtin IS d.dependency_builtin + AND q.object_id IS d.dependency_object_id + AND q.component_index IS d.dependency_component_index + JOIN $scopeTableName s + ON d.dependent_object_id = s.object_id + AND d.dependent_component_index = s.component_index + JOIN object o ON s.object_id = o.id + |] + + -- Drop the temporary tables + execute [sql| DROP TABLE $scopeTableName |] + execute [sql| DROP TABLE $queryTableName |] + + -- Post-process the query result + let dependents1 = + List.foldl' + ( \deps -> \case + dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types + dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types) + _ -> deps -- impossible; could error here + ) + (Defns Set.empty Set.empty) + dependents0 + + pure dependents1 + +-- | `getTransitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope` +-- (not including `query` itself). +getTransitiveDependentsWithinScope :: + Set S.Reference.Id -> + Set S.Reference -> + Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId) +getTransitiveDependentsWithinScope scope query = do + -- Populate a temporary table with all of the references in `scope` + let scopeTableName = [sql| dependents_search_scope |] + createTemporaryTableOfReferenceIds scopeTableName scope + + -- Populate a temporary table with all of the references in `query` + let queryTableName = [sql| dependencies_query |] + createTemporaryTableOfReferences queryTableName query -- Say the query set is { #foo, #bar }, and the scope set is { #foo, #bar, #baz, #qux, #honk }. -- @@ -1917,34 +1973,80 @@ getDependentsWithinScope scope query = do -- We use `UNION` rather than `UNION ALL` so as to not track down the transitive dependents of any particular -- reference more than once. - result :: [Reference.Id :. Only ObjectType] <- queryListRow [sql| - WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS ( - SELECT d.dependent_object_id, d.dependent_component_index, object.type_id - FROM dependents_index d - JOIN object ON d.dependent_object_id = object.id - JOIN dependencies_query q - ON q.dependency_builtin IS d.dependency_builtin - AND q.dependency_object_id IS d.dependency_object_id - AND q.dependency_component_index IS d.dependency_component_index - JOIN dependents_search_scope s - ON s.dependent_object_id = d.dependent_object_id - AND s.dependent_component_index = d.dependent_component_index - - UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id - FROM dependents_index d - JOIN object ON d.dependent_object_id = object.id - JOIN transitive_dependents t - ON t.dependent_object_id = d.dependency_object_id - AND t.dependent_component_index = d.dependency_component_index - JOIN dependents_search_scope s - ON s.dependent_object_id = d.dependent_object_id - AND s.dependent_component_index = d.dependent_component_index - ) - SELECT * FROM transitive_dependents - |] - execute [sql|DROP TABLE dependents_search_scope|] - execute [sql|DROP TABLE dependencies_query|] - pure . Map.fromList $ [(r, t) | r :. Only t <- result] + result0 :: [S.Reference.Id :. Only ObjectType] <- + queryListRow + [sql| + WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS ( + SELECT d.dependent_object_id, d.dependent_component_index, object.type_id + FROM dependents_index d + JOIN object ON d.dependent_object_id = object.id + JOIN $queryTableName q + ON q.builtin IS d.dependency_builtin + AND q.object_id IS d.dependency_object_id + AND q.component_index IS d.dependency_component_index + JOIN $scopeTableName s + ON s.object_id = d.dependent_object_id + AND s.component_index = d.dependent_component_index + + UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id + FROM dependents_index d + JOIN object ON d.dependent_object_id = object.id + JOIN transitive_dependents t + ON t.dependent_object_id = d.dependency_object_id + AND t.dependent_component_index = d.dependency_component_index + JOIN $scopeTableName s + ON s.object_id = d.dependent_object_id + AND s.component_index = d.dependent_component_index + ) + SELECT * FROM transitive_dependents + |] + + execute [sql| DROP TABLE $scopeTableName |] + execute [sql| DROP TABLE $queryTableName |] + + -- Post-process the query result + let result1 = + List.foldl' + ( \deps -> \case + dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types + dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types) + _ -> deps -- impossible; could error here + ) + (Defns Set.empty Set.empty) + result0 + + pure result1 + +createTemporaryTableOfReferences :: Sql -> Set S.Reference -> Transaction () +createTemporaryTableOfReferences tableName refs = do + execute + [sql| + CREATE TEMPORARY TABLE $tableName ( + builtin INTEGER NULL, + object_id INTEGER NULL, + component_index INTEGER NULL + CHECK ((builtin IS NULL) = (object_id IS NOT NULL)), + CHECK ((object_id IS NULL) = (component_index IS NULL)) + ) + |] + + for_ refs \ref -> + execute [sql| INSERT INTO $tableName VALUES (@ref, @, @) |] + +createTemporaryTableOfReferenceIds :: Sql -> Set S.Reference.Id -> Transaction () +createTemporaryTableOfReferenceIds tableName refs = do + execute + [sql| + CREATE TEMPORARY TABLE $tableName ( + object_id INTEGER NOT NULL, + component_index INTEGER NOT NULL, + PRIMARY KEY (object_id, component_index) + ) + |] + for_ refs \ref -> + execute [sql| INSERT INTO $tableName VALUES (@ref, @) |] + +{- ORMOLU_DISABLE -} objectIdByBase32Prefix :: ObjectType -> Text -> Transaction [ObjectId] objectIdByBase32Prefix objType prefix = @@ -2086,7 +2188,7 @@ deleteNameLookupsExceptFor hashIds = do |] -- | Insert the given set of term names into the name lookup table -insertScopedTermNames :: BranchHashId -> [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] -> Transaction () +insertScopedTermNames :: BranchHashId -> [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] -> Transaction () insertScopedTermNames bhId = do traverse_ \name0 -> do let name = NamedRef.ScopedRow (refToRow <$> name0) @@ -2106,11 +2208,11 @@ insertScopedTermNames bhId = do VALUES (:bhId, @name, @, @, @, @, @, @, @) |] where - refToRow :: (Referent.TextReferent, Maybe NamedRef.ConstructorType) -> (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType)) + refToRow :: (S.TextReferent, Maybe NamedRef.ConstructorType) -> (S.TextReferent :. Only (Maybe NamedRef.ConstructorType)) refToRow (ref, ct) = ref :. Only ct -- | Insert the given set of type names into the name lookup table -insertScopedTypeNames :: BranchHashId -> [NamedRef Reference.TextReference] -> Transaction () +insertScopedTypeNames :: BranchHashId -> [NamedRef S.TextReference] -> Transaction () insertScopedTypeNames bhId = traverse_ \name0 -> do let name = NamedRef.ScopedRow name0 @@ -2129,7 +2231,7 @@ insertScopedTypeNames bhId = |] -- | Remove the given set of term names into the name lookup table -removeScopedTermNames :: BranchHashId -> [NamedRef Referent.TextReferent] -> Transaction () +removeScopedTermNames :: BranchHashId -> [NamedRef S.TextReferent] -> Transaction () removeScopedTermNames bhId names = do for_ names \name -> execute @@ -2144,7 +2246,7 @@ removeScopedTermNames bhId names = do |] -- | Remove the given set of term names into the name lookup table -removeScopedTypeNames :: BranchHashId -> [NamedRef Reference.TextReference] -> Transaction () +removeScopedTypeNames :: BranchHashId -> [NamedRef S.TextReference] -> Transaction () removeScopedTypeNames bhId names = do for_ names \name -> execute @@ -2203,9 +2305,9 @@ likeEscape escapeChar pat = -- -- Get the list of a term names in the provided name lookup and relative namespace. -- Includes dependencies, but not transitive dependencies. -termNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] +termNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] termNamesWithinNamespace bhId namespace = do - results :: [NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- + results :: [NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- queryListRow [sql| SELECT reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type @@ -2236,7 +2338,7 @@ termNamesWithinNamespace bhId namespace = do -- -- Get the list of a type names in the provided name lookup and relative namespace. -- Includes dependencies, but not transitive dependencies. -typeNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef Reference.TextReference] +typeNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef S.TextReference] typeNamesWithinNamespace bhId namespace = queryListRow [sql| @@ -2265,13 +2367,13 @@ typeNamesWithinNamespace bhId namespace = -- is only true on Share. -- -- Get the list of term names within a given namespace which have the given suffix. -termNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] +termNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] termNamesBySuffix bhId namespaceRoot suffix = do Debug.debugM Debug.Server "termNamesBySuffix" (namespaceRoot, suffix) let namespaceGlob = toNamespaceGlob namespaceRoot let lastSegment = NonEmpty.head . into @(NonEmpty Text) $ suffix let reversedNameGlob = toSuffixGlob suffix - results :: [NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- + results :: [NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- -- Note: It may seem strange that we do a last_name_segment constraint AND a reversed_name -- GLOB, but this helps improve query performance. -- The SQLite query optimizer is smart enough to do a prefix-search on globs, but will @@ -2304,7 +2406,7 @@ termNamesBySuffix bhId namespaceRoot suffix = do -- is only true on Share. -- -- Get the list of type names within a given namespace which have the given suffix. -typeNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef Reference.TextReference] +typeNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef S.TextReference] typeNamesBySuffix bhId namespaceRoot suffix = do Debug.debugM Debug.Server "typeNamesBySuffix" (namespaceRoot, suffix) let namespaceGlob = toNamespaceGlob namespaceRoot @@ -2343,10 +2445,10 @@ typeNamesBySuffix bhId namespaceRoot suffix = do -- id. It's the caller's job to select the correct name lookup for your exact name. -- -- See termRefsForExactName in U.Codebase.Sqlite.Operations -termRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] +termRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] termRefsForExactName bhId reversedSegments = do let reversedName = toReversedName reversedSegments - results :: [NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- + results :: [NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- queryListRow [sql| SELECT reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type @@ -2366,7 +2468,7 @@ termRefsForExactName bhId reversedSegments = do -- id. It's the caller's job to select the correct name lookup for your exact name. -- -- See termRefsForExactName in U.Codebase.Sqlite.Operations -typeRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef Reference.TextReference] +typeRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef S.TextReference] typeRefsForExactName bhId reversedSegments = do let reversedName = toReversedName reversedSegments queryListRow @@ -2382,7 +2484,7 @@ typeRefsForExactName bhId reversedSegments = do -- -- Get the list of term names for a given Referent within a given namespace. -- Considers one level of dependencies, but not transitive dependencies. -termNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> Referent.TextReferent -> Maybe ReversedName -> Transaction [ReversedName] +termNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> S.TextReferent -> Maybe ReversedName -> Transaction [ReversedName] termNamesForRefWithinNamespace bhId namespaceRoot ref maySuffix = do let namespaceGlob = toNamespaceGlob namespaceRoot let suffixGlob = case maySuffix of @@ -2431,7 +2533,7 @@ termNamesForRefWithinNamespace bhId namespaceRoot ref maySuffix = do -- -- Get the list of type names for a given Reference within a given namespace. -- Considers one level of dependencies, but not transitive dependencies. -typeNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> Reference.TextReference -> Maybe ReversedName -> Transaction [ReversedName] +typeNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> S.TextReference -> Maybe ReversedName -> Transaction [ReversedName] typeNamesForRefWithinNamespace bhId namespaceRoot ref maySuffix = do let namespaceGlob = toNamespaceGlob namespaceRoot let suffixGlob = case maySuffix of @@ -2511,7 +2613,7 @@ transitiveDependenciesSql rootBranchHashId = -- Note: this returns the first name it finds by searching in order of: -- Names in the current namespace, then names in the current namespace's dependencies, then -- through the current namespace's dependencies' dependencies, etc. -recursiveTermNameSearch :: BranchHashId -> Referent.TextReferent -> Transaction (Maybe ReversedName) +recursiveTermNameSearch :: BranchHashId -> S.TextReferent -> Transaction (Maybe ReversedName) recursiveTermNameSearch bhId ref = do queryMaybeColCheck [sql| @@ -2548,7 +2650,7 @@ recursiveTermNameSearch bhId ref = do -- Note: this returns the first name it finds by searching in order of: -- Names in the current namespace, then names in the current namespace's dependencies, then -- through the current namespace's dependencies' dependencies, etc. -recursiveTypeNameSearch :: BranchHashId -> Reference.TextReference -> Transaction (Maybe ReversedName) +recursiveTypeNameSearch :: BranchHashId -> S.TextReference -> Transaction (Maybe ReversedName) recursiveTypeNameSearch bhId ref = do queryMaybeColCheck [sql| @@ -2589,13 +2691,13 @@ recursiveTypeNameSearch bhId ref = do -- the longest matching suffix. -- -- Considers one level of dependencies, but not transitive dependencies. -longestMatchingTermNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef Referent.TextReferent -> Transaction (Maybe (NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType))) +longestMatchingTermNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef S.TextReferent -> Transaction (Maybe (NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType))) longestMatchingTermNameForSuffixification bhId namespaceRoot (NamedRef.NamedRef {reversedSegments = revSuffix@(ReversedName (lastSegment NonEmpty.:| _)), ref}) = do let namespaceGlob = toNamespaceGlob namespaceRoot <> ".*" - let loop :: [Text] -> MaybeT Transaction (NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)) + let loop :: [Text] -> MaybeT Transaction (NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)) loop [] = empty loop (suffGlob : rest) = do - result :: Maybe (NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))) <- + result :: Maybe (NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))) <- lift $ queryMaybeRow -- Note: It may seem strange that we do a last_name_segment constraint AND a reversed_name @@ -2664,13 +2766,13 @@ longestMatchingTermNameForSuffixification bhId namespaceRoot (NamedRef.NamedRef -- the longest matching suffix. -- -- Considers one level of dependencies, but not transitive dependencies. -longestMatchingTypeNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef Reference.TextReference -> Transaction (Maybe (NamedRef Reference.TextReference)) +longestMatchingTypeNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef S.TextReference -> Transaction (Maybe (NamedRef S.TextReference)) longestMatchingTypeNameForSuffixification bhId namespaceRoot (NamedRef.NamedRef {reversedSegments = revSuffix@(ReversedName (lastSegment NonEmpty.:| _)), ref}) = do let namespaceGlob = toNamespaceGlob namespaceRoot <> ".*" - let loop :: [Text] -> MaybeT Transaction (NamedRef Reference.TextReference) + let loop :: [Text] -> MaybeT Transaction (NamedRef S.TextReference) loop [] = empty loop (suffGlob : rest) = do - result :: Maybe (NamedRef (Reference.TextReference)) <- + result :: Maybe (NamedRef (S.TextReference)) <- lift $ queryMaybeRow -- Note: It may seem strange that we do a last_name_segment constraint AND a reversed_name @@ -3036,12 +3138,12 @@ saveTermComponent hh@HashHandle {toReference, toReferenceMentions} maybeEncodedT tpRefs' = Foldable.toList $ C.Type.dependencies tp getTermSRef :: S.Term.TermRef -> S.Reference getTermSRef = \case - C.ReferenceBuiltin t -> C.ReferenceBuiltin (tIds Vector.! fromIntegral t) + ReferenceBuiltin t -> ReferenceBuiltin (tIds Vector.! fromIntegral t) C.Reference.Derived Nothing i -> C.Reference.Derived oId i -- index self-references C.Reference.Derived (Just h) i -> C.Reference.Derived (oIds Vector.! fromIntegral h) i getTypeSRef :: S.Term.TypeRef -> S.Reference getTypeSRef = \case - C.ReferenceBuiltin t -> C.ReferenceBuiltin (tIds Vector.! fromIntegral t) + ReferenceBuiltin t -> ReferenceBuiltin (tIds Vector.! fromIntegral t) C.Reference.Derived h i -> C.Reference.Derived (oIds Vector.! fromIntegral h) i getSTypeLink = getTypeSRef getSTermLink :: S.Term.TermLink -> S.Reference @@ -3096,7 +3198,7 @@ saveDeclComponent hh@HashHandle {toReferenceDecl, toReferenceDeclMentions} maybe dependencies :: Set S.Decl.TypeRef = C.Decl.dependencies decl getSRef :: C.Reference.Reference' LocalTextId (Maybe LocalDefnId) -> S.Reference.Reference getSRef = \case - C.ReferenceBuiltin t -> C.ReferenceBuiltin (tIds Vector.! fromIntegral t) + ReferenceBuiltin t -> ReferenceBuiltin (tIds Vector.! fromIntegral t) C.Reference.Derived Nothing i -> C.Reference.Derived oId i -- index self-references C.Reference.Derived (Just h) i -> C.Reference.Derived (oIds Vector.! fromIntegral h) i in (Set.map getSRef dependencies, self) @@ -3372,20 +3474,55 @@ loadNamespaceStatsByHashId bhId = do WHERE namespace_hash_id = :bhId |] -appendReflog :: Reflog.Entry CausalHashId Text -> Transaction () -appendReflog entry = +getDeprecatedRootReflog :: Int -> Transaction [Reflog.Entry CausalHashId Text] +getDeprecatedRootReflog numEntries = + queryListRow + [sql| + SELECT time, from_root_causal_id, to_root_causal_id, reason + FROM reflog + ORDER BY time DESC + LIMIT :numEntries + |] + +appendProjectBranchReflog :: ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId -> Transaction () +appendProjectBranchReflog entry = execute [sql| - INSERT INTO reflog (time, from_root_causal_id, to_root_causal_id, reason) - VALUES (@entry, @, @, @) + INSERT INTO project_branch_reflog (project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason) + VALUES (@entry, @, @, @, @, @) |] -getReflog :: Int -> Transaction [Reflog.Entry CausalHashId Text] -getReflog numEntries = +-- | Get x number of entries from the project reflog for the provided project +getProjectReflog :: Int -> ProjectId -> Transaction [ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId] +getProjectReflog numEntries projectId = queryListRow [sql| - SELECT time, from_root_causal_id, to_root_causal_id, reason - FROM reflog + SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason + FROM project_branch_reflog + WHERE project_id = :projectId + ORDER BY time DESC + LIMIT :numEntries + |] + +-- | Get x number of entries from the project reflog for the provided branch. +getProjectBranchReflog :: Int -> ProjectBranchId -> Transaction [ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId] +getProjectBranchReflog numEntries projectBranchId = + queryListRow + [sql| + SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason + FROM project_branch_reflog + WHERE project_branch_id = :projectBranchId + ORDER BY time DESC + LIMIT :numEntries + |] + +-- | Get x number of entries from the global reflog spanning all projects +getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId] +getGlobalReflog numEntries = + queryListRow + [sql| + SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason + FROM project_branch_reflog ORDER BY time DESC LIMIT :numEntries |] @@ -3679,12 +3816,15 @@ loadProjectAndBranchNames projectId branchId = |] -- | Insert a project branch. -insertProjectBranch :: ProjectBranch -> Transaction () -insertProjectBranch (ProjectBranch projectId branchId branchName maybeParentBranchId) = do +insertProjectBranch :: (HasCallStack) => Text -> CausalHashId -> ProjectBranch -> Transaction () +insertProjectBranch description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do + -- Ensure we never point at a causal we don't have the branch for. + _ <- expectBranchObjectIdByCausalHashId causalHashId + execute [sql| - INSERT INTO project_branch (project_id, branch_id, name) - VALUES (:projectId, :branchId, :branchName) + INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id) + VALUES (:projectId, :branchId, :branchName, :causalHashId) |] whenJust maybeParentBranchId \parentBranchId -> execute @@ -3692,6 +3832,16 @@ insertProjectBranch (ProjectBranch projectId branchId branchName maybeParentBran INSERT INTO project_branch_parent (project_id, parent_branch_id, branch_id) VALUES (:projectId, :parentBranchId, :branchId) |] + time <- Sqlite.unsafeIO $ Time.getCurrentTime + appendProjectBranchReflog $ + ProjectReflog.Entry + { project = projectId, + branch = branchId, + time, + fromRootCausalHash = Nothing, + toRootCausalHash = causalHashId, + reason = description + } -- | Rename a project branch. -- @@ -3740,7 +3890,7 @@ deleteProject projectId = do -- After deleting `topic`: -- -- main <- topic2 -deleteProjectBranch :: ProjectId -> ProjectBranchId -> Transaction () +deleteProjectBranch :: (HasCallStack) => ProjectId -> ProjectBranchId -> Transaction () deleteProjectBranch projectId branchId = do maybeParentBranchId :: Maybe ProjectBranchId <- queryMaybeCol @@ -3764,6 +3914,38 @@ deleteProjectBranch projectId branchId = do WHERE project_id = :projectId AND branch_id = :branchId |] +-- | Set project branch HEAD +setProjectBranchHead :: Text -> ProjectId -> ProjectBranchId -> CausalHashId -> Transaction () +setProjectBranchHead description projectId branchId causalHashId = do + -- Ensure we never point at a causal we don't have the branch for. + _ <- expectBranchObjectIdByCausalHashId causalHashId + oldRootCausalHashId <- expectProjectBranchHead projectId branchId + execute + [sql| + UPDATE project_branch + SET causal_hash_id = :causalHashId + WHERE project_id = :projectId AND branch_id = :branchId + |] + time <- Sqlite.unsafeIO $ Time.getCurrentTime + appendProjectBranchReflog $ + ProjectReflog.Entry + { project = projectId, + branch = branchId, + time = time, + fromRootCausalHash = Just oldRootCausalHashId, + toRootCausalHash = causalHashId, + reason = description + } + +expectProjectBranchHead :: (HasCallStack) => ProjectId -> ProjectBranchId -> Transaction CausalHashId +expectProjectBranchHead projectId branchId = + queryOneCol + [sql| + SELECT causal_hash_id + FROM project_branch + WHERE project_id = :projectId AND branch_id = :branchId + |] + data LoadRemoteBranchFlag = IncludeSelfRemote | ExcludeSelfRemote @@ -4144,7 +4326,7 @@ loadMostRecentBranch projectId = -- | Searches for all names within the given name lookup which contain the provided list of segments -- in order. -- Search is case insensitive. -fuzzySearchTerms :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType))] +fuzzySearchTerms :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType))] fuzzySearchTerms includeDependencies bhId limit namespace querySegments = do -- Union in the dependencies if required. let dependenciesSql = @@ -4179,14 +4361,14 @@ fuzzySearchTerms includeDependencies bhId limit namespace querySegments = do where namespaceGlob = toNamespaceGlob namespace preparedQuery = prepareFuzzyQuery '\\' querySegments - unRow :: NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType)) -> NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType) + unRow :: NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType)) -> NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType) unRow = fmap \(a :. Only b) -> (a, b) -- | Searches for all names within the given name lookup which contain the provided list of segments -- in order. -- -- Search is case insensitive. -fuzzySearchTypes :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef Reference.TextReference)] +fuzzySearchTypes :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef S.TextReference)] fuzzySearchTypes includeDependencies bhId limit namespace querySegments = do -- Union in the dependencies if required. let dependenciesSql = @@ -4248,33 +4430,39 @@ data JsonParseFailure = JsonParseFailure deriving anyclass (SqliteExceptionReason) -- | Get the most recent namespace the user has visited. -expectMostRecentNamespace :: Transaction [NameSegment] -expectMostRecentNamespace = - queryOneColCheck +expectCurrentProjectPath :: (HasCallStack) => Transaction (ProjectId, ProjectBranchId, [NameSegment]) +expectCurrentProjectPath = + queryOneRowCheck [sql| - SELECT namespace - FROM most_recent_namespace + SELECT project_id, branch_id, path + FROM current_project_path |] check where - check :: Text -> Either JsonParseFailure [NameSegment] - check bytes = - case Aeson.eitherDecodeStrict (Text.encodeUtf8 bytes) of - Left failure -> Left JsonParseFailure {bytes, failure = Text.pack failure} - Right namespace -> Right (map NameSegment namespace) + check :: (ProjectId, ProjectBranchId, Text) -> Either JsonParseFailure (ProjectId, ProjectBranchId, [NameSegment]) + check (projId, branchId, pathText) = + case Aeson.eitherDecodeStrict (Text.encodeUtf8 pathText) of + Left failure -> Left JsonParseFailure {bytes = pathText, failure = Text.pack failure} + Right namespace -> Right (projId, branchId, map NameSegment namespace) -- | Set the most recent namespace the user has visited. -setMostRecentNamespace :: [NameSegment] -> Transaction () -setMostRecentNamespace namespace = +setCurrentProjectPath :: + ProjectId -> + ProjectBranchId -> + [NameSegment] -> + Transaction () +setCurrentProjectPath projId branchId path = do + execute + [sql| DELETE FROM current_project_path |] execute [sql| - UPDATE most_recent_namespace - SET namespace = :json + INSERT INTO current_project_path(project_id, branch_id, path) + VALUES (:projId, :branchId, :jsonPath) |] where - json :: Text - json = - Text.Lazy.toStrict (Aeson.encodeToLazyText $ NameSegment.toUnescapedText <$> namespace) + jsonPath :: Text + jsonPath = + Text.Lazy.toStrict (Aeson.encodeToLazyText $ NameSegment.toUnescapedText <$> path) -- | Get the causal hash result from squashing the provided branch hash if we've squashed it -- at some point in the past. diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs index ca228f83d1..7c45dbc97d 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs @@ -14,12 +14,20 @@ import Unison.Sqlite (FromField, FromRow (fromRow), Only (..), RowParser, SQLDat type Reference = Reference' TextId ObjectId +type TermReference = Reference + +type TypeReference = Reference + -- | The name lookup table uses this because normalizing/denormalizing hashes to ids is slower -- than we'd like when writing/reading the entire name lookup table. type TextReference = Reference' Text Base32Hex type Id = Id' ObjectId +type TermReferenceId = Id + +type TypeReferenceId = Id + type LocalReferenceH = Reference' LocalTextId LocalHashId type LocalReference = Reference' LocalTextId LocalDefnId diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs index 98554c38d1..55c3213f4a 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs @@ -462,7 +462,7 @@ putDeclFormat = \case putDeclComponent (DeclFormat.LocallyIndexedComponent v) = putFramedArray (putPair putLocalIds putDeclElement) v -putDeclElement :: MonadPut m => Decl.DeclR DeclFormat.TypeRef Symbol -> m () +putDeclElement :: (MonadPut m) => Decl.DeclR DeclFormat.TypeRef Symbol -> m () putDeclElement Decl.DataDeclaration {..} = do putDeclType declType putModifier modifier @@ -499,7 +499,7 @@ getDeclElement = 1 -> pure Decl.Effect other -> unknownTag "DeclType" other -getModifier :: MonadGet m => m Modifier +getModifier :: (MonadGet m) => m Modifier getModifier = getWord8 >>= \case 0 -> pure Decl.Structural @@ -720,7 +720,7 @@ getLocalBranch = x -> unknownTag "getMetadataSetFormat" x getBranchDiff' :: - MonadGet m => + (MonadGet m) => m branchRef -> m (BranchFormat.BranchLocalIds' text defRef patchRef childRef) -> m (BranchFormat.BranchFormat' text defRef patchRef childRef branchRef) diff --git a/codebase2/codebase-sqlite/package.yaml b/codebase2/codebase-sqlite/package.yaml index a04fce3a56..01c4c22544 100644 --- a/codebase2/codebase-sqlite/package.yaml +++ b/codebase2/codebase-sqlite/package.yaml @@ -27,10 +27,12 @@ dependencies: - nonempty-containers - safe - text + - time - transformers - unison-codebase - unison-codebase-sync - unison-core + - unison-core1 - unison-core-orphans-sqlite - unison-hash - unison-hash-orphans-sqlite @@ -71,6 +73,7 @@ default-extensions: - MultiParamTypeClasses - NamedFieldPuns - OverloadedLabels + - OverloadedRecordDot - OverloadedStrings - PatternSynonyms - QuasiQuotes diff --git a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql new file mode 100644 index 0000000000..8de5f05169 --- /dev/null +++ b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql @@ -0,0 +1,15 @@ +-- The most recent namespace that a user cd'd to. +-- This table should never have more than one row. +CREATE TABLE current_project_path ( + project_id INTEGER NOT NULL, + branch_id INTEGER NOT NULL, + -- A json array like ["foo", "bar"]; the root namespace is represented by the empty array + path TEXT PRIMARY KEY NOT NULL, + + foreign key (project_id, branch_id) + references project_branch (project_id, branch_id) + -- Prevent deleting the project you're currently in. + on delete no action +) WITHOUT ROWID; + +DROP TABLE most_recent_namespace; diff --git a/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql new file mode 100644 index 0000000000..5142051033 --- /dev/null +++ b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql @@ -0,0 +1,32 @@ +-- A reflog which is tied to the project/branch +CREATE TABLE project_branch_reflog ( + project_id INTEGER NOT NULL, + project_branch_id INTEGER NOT NULL, + -- Reminder that SQLITE doesn't have any actual 'time' type, + -- This column contains TEXT values formatted as ISO8601 strings + -- ("YYYY-MM-DD HH:MM:SS.SSS") + time TEXT NOT NULL, + -- from_root_causal_id will be null if the branch was just created + from_root_causal_id INTEGER NULL REFERENCES causal(self_hash_id), + to_root_causal_id INTEGER NOT NULL REFERENCES causal(self_hash_id), + reason TEXT NOT NULL, + + foreign key (project_id, project_branch_id) + references project_branch (project_id, branch_id) + on delete cascade +); + +CREATE INDEX project_branch_reflog_by_time ON project_branch_reflog ( + project_branch_id, time DESC +); + + +CREATE INDEX project_reflog_by_time ON project_branch_reflog ( + project_id, time DESC +); + +CREATE INDEX global_reflog_by_time ON project_branch_reflog ( + time DESC +); + + diff --git a/codebase2/codebase-sqlite/sql/014-add-project-branch-causal-hash-id.sql b/codebase2/codebase-sqlite/sql/014-add-project-branch-causal-hash-id.sql new file mode 100644 index 0000000000..588c6228eb --- /dev/null +++ b/codebase2/codebase-sqlite/sql/014-add-project-branch-causal-hash-id.sql @@ -0,0 +1,2 @@ +-- Add a new column to the project_branch table to store the causal_hash_id +ALTER TABLE project_branch ADD COLUMN causal_hash_id INTEGER NOT NULL; diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index ac1f606921..f5211b310d 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack @@ -21,6 +21,9 @@ extra-source-files: sql/009-add-squash-cache-table.sql sql/010-ensure-squash-cache-table.sql sql/011-cd-to-project-root.sql + sql/012-add-current-project-path-table.sql + sql/013-add-project-branch-reflog-table.sql + sql/014-add-project-branch-causal-hash-id.sql sql/create.sql source-repository head @@ -54,6 +57,7 @@ library U.Codebase.Sqlite.Patch.TypeEdit U.Codebase.Sqlite.Project U.Codebase.Sqlite.ProjectBranch + U.Codebase.Sqlite.ProjectReflog U.Codebase.Sqlite.Queries U.Codebase.Sqlite.Reference U.Codebase.Sqlite.Referent @@ -91,6 +95,7 @@ library MultiParamTypeClasses NamedFieldPuns OverloadedLabels + OverloadedRecordDot OverloadedStrings PatternSynonyms QuasiQuotes @@ -120,11 +125,13 @@ library , nonempty-containers , safe , text + , time , transformers , unison-codebase , unison-codebase-sync , unison-core , unison-core-orphans-sqlite + , unison-core1 , unison-hash , unison-hash-orphans-sqlite , unison-prelude diff --git a/codebase2/codebase/U/Codebase/Causal.hs b/codebase2/codebase/U/Codebase/Causal.hs index aad0d36fa0..74e4c1fcf0 100644 --- a/codebase2/codebase/U/Codebase/Causal.hs +++ b/codebase2/codebase/U/Codebase/Causal.hs @@ -19,11 +19,11 @@ data Causal m hc he pe e = Causal } deriving stock (Functor, Generic) -instance Eq hc => Eq (Causal m hc he pe e) where +instance (Eq hc) => Eq (Causal m hc he pe e) where (==) = (==) `on` causalHash -- | @emap f g@ maps over the values and parents' values with @f@ and @g@. -emap :: Functor m => (e -> e') -> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e' +emap :: (Functor m) => (e -> e') -> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e' emap f g causal@Causal {parents, value} = causal { parents = Map.map (fmap (emap g g)) parents, diff --git a/codebase2/codebase/U/Codebase/Decl.hs b/codebase2/codebase/U/Codebase/Decl.hs index 26172ed1db..7a46ea9fc0 100644 --- a/codebase2/codebase/U/Codebase/Decl.hs +++ b/codebase2/codebase/U/Codebase/Decl.hs @@ -41,11 +41,11 @@ data DeclR r v = DataDeclaration } deriving (Show) -allVars :: Ord v => DeclR r v -> Set v +allVars :: (Ord v) => DeclR r v -> Set v allVars (DataDeclaration _ _ bound constructorTypes) = (Set.fromList $ foldMap ABT.allVars constructorTypes) <> Set.fromList bound -vmap :: Ord v' => (v -> v') -> DeclR r v -> DeclR r v' +vmap :: (Ord v') => (v -> v') -> DeclR r v -> DeclR r v' vmap f (DataDeclaration {declType, modifier, bound, constructorTypes}) = DataDeclaration { declType, @@ -82,7 +82,7 @@ data F a -- to the relevant piece of the component in the component map. unhashComponent :: forall v extra. - ABT.Var v => + (ABT.Var v) => Hash -> -- | A function to convert a reference to a variable. The actual var names aren't important. (Reference.Id -> v) -> diff --git a/codebase2/codebase/U/Codebase/Referent.hs b/codebase2/codebase/U/Codebase/Referent.hs index 7eeeccba85..93aec093a8 100644 --- a/codebase2/codebase/U/Codebase/Referent.hs +++ b/codebase2/codebase/U/Codebase/Referent.hs @@ -63,7 +63,7 @@ type Id = Id' Hash Hash data Id' hTm hTp = RefId (Reference.Id' hTm) | ConId (Reference.Id' hTp) ConstructorId - deriving (Eq, Ord, Show) + deriving (Eq, Functor, Ord, Show) instance Bifunctor Referent' where bimap f g = \case diff --git a/codebase2/codebase/U/Codebase/Reflog.hs b/codebase2/codebase/U/Codebase/Reflog.hs index 971bc48395..27cc5ea59d 100644 --- a/codebase2/codebase/U/Codebase/Reflog.hs +++ b/codebase2/codebase/U/Codebase/Reflog.hs @@ -13,6 +13,7 @@ data Entry causal text = Entry toRootCausalHash :: causal, reason :: text } + deriving (Functor) instance Bifunctor Entry where bimap = bimapDefault diff --git a/codebase2/codebase/U/Codebase/Term.hs b/codebase2/codebase/U/Codebase/Term.hs index 3af9a5faff..57691ba6ec 100644 --- a/codebase2/codebase/U/Codebase/Term.hs +++ b/codebase2/codebase/U/Codebase/Term.hs @@ -207,7 +207,7 @@ extraMapM ftext ftermRef ftypeRef ftermLink ftypeLink fvt = go' rmapPattern :: (t -> t') -> (r -> r') -> Pattern t r -> Pattern t' r' rmapPattern ft fr p = runIdentity . rmapPatternM (pure . ft) (pure . fr) $ p -rmapPatternM :: Applicative m => (t -> m t') -> (r -> m r') -> Pattern t r -> m (Pattern t' r') +rmapPatternM :: (Applicative m) => (t -> m t') -> (r -> m r') -> Pattern t r -> m (Pattern t' r') rmapPatternM ft fr = go where go = \case @@ -260,7 +260,7 @@ dependencies = -- to the relevant piece of the component in the component map. unhashComponent :: forall v extra. - ABT.Var v => + (ABT.Var v) => -- | The hash of the component, this is used to fill in self-references. Hash -> -- | A function to convert a reference to a variable. The actual var names aren't important. diff --git a/codebase2/core/U/Codebase/Reference.hs b/codebase2/core/U/Codebase/Reference.hs index 1146ca8aa1..e40ce2ac37 100644 --- a/codebase2/core/U/Codebase/Reference.hs +++ b/codebase2/core/U/Codebase/Reference.hs @@ -74,7 +74,7 @@ data ReferenceType = RtTerm | RtType deriving (Eq, Ord, Show) data Reference' t h = ReferenceBuiltin t | ReferenceDerived (Id' h) - deriving stock (Eq, Generic, Ord, Show) + deriving stock (Eq, Generic, Functor, Ord, Show) -- | A type declaration reference. type TermReference' t h = Reference' t h diff --git a/codebase2/core/Unison/Core/Project.hs b/codebase2/core/Unison/Core/Project.hs index 632f9702ec..8f5e05eca6 100644 --- a/codebase2/core/Unison/Core/Project.hs +++ b/codebase2/core/Unison/Core/Project.hs @@ -29,7 +29,7 @@ data ProjectAndBranch a b = ProjectAndBranch { project :: a, branch :: b } - deriving stock (Eq, Generic, Show) + deriving stock (Eq, Generic, Show, Functor) instance Bifunctor ProjectAndBranch where bimap f g (ProjectAndBranch a b) = ProjectAndBranch (f a) (g b) diff --git a/codebase2/core/Unison/NameSegment/Internal.hs b/codebase2/core/Unison/NameSegment/Internal.hs index 9ecc1ff43b..a7c108c4a5 100644 --- a/codebase2/core/Unison/NameSegment/Internal.hs +++ b/codebase2/core/Unison/NameSegment/Internal.hs @@ -27,12 +27,13 @@ newtype NameSegment = NameSegment deriving newtype (Alphabetical) instance - TypeError - ( 'TypeError.Text "You cannot implicitly convert a ‘String’ to a ‘NameSegment’. If you need a" - ':$$: 'TypeError.Text "special-cased segment it should exist as a constant in" - ':$$: 'TypeError.Text "“Unison.NameSegment”, otherwise it should be parsed via" - ':$$: 'TypeError.Text "“Unison.Syntax.NameSegment”." - ) => + ( TypeError + ( 'TypeError.Text "You cannot implicitly convert a ‘String’ to a ‘NameSegment’. If you need a" + ':$$: 'TypeError.Text "special-cased segment it should exist as a constant in" + ':$$: 'TypeError.Text "“Unison.NameSegment”, otherwise it should be parsed via" + ':$$: 'TypeError.Text "“Unison.Syntax.NameSegment”." + ) + ) => IsString NameSegment where fromString = undefined diff --git a/codebase2/core/Unison/Util/Alphabetical.hs b/codebase2/core/Unison/Util/Alphabetical.hs index b87bfea3f7..1c84ead241 100644 --- a/codebase2/core/Unison/Util/Alphabetical.hs +++ b/codebase2/core/Unison/Util/Alphabetical.hs @@ -18,10 +18,10 @@ import Data.Text (Text) class (Eq n) => Alphabetical n where compareAlphabetical :: n -> n -> Ordering -sortAlphabetically :: Alphabetical a => [a] -> [a] +sortAlphabetically :: (Alphabetical a) => [a] -> [a] sortAlphabetically as = (\(OrderAlphabetically a) -> a) <$> List.sort (map OrderAlphabetically as) -sortAlphabeticallyOn :: Alphabetical a => (b -> a) -> [b] -> [b] +sortAlphabeticallyOn :: (Alphabetical a) => (b -> a) -> [b] -> [b] sortAlphabeticallyOn f = List.sortOn (OrderAlphabetically . f) instance Alphabetical Text where diff --git a/codebase2/util-serialization/U/Util/Serialization.hs b/codebase2/util-serialization/U/Util/Serialization.hs index ecc90fe439..2d4f1bd7ae 100644 --- a/codebase2/util-serialization/U/Util/Serialization.hs +++ b/codebase2/util-serialization/U/Util/Serialization.hs @@ -8,7 +8,7 @@ module U.Util.Serialization where -import Control.Applicative (Applicative (liftA2), liftA3) +import Control.Applicative (liftA3) import Control.Monad (foldM, replicateM, replicateM_, when) import Data.Bits (Bits, clearBit, setBit, shiftL, shiftR, testBit, (.|.)) import Data.ByteString (ByteString, readFile, writeFile) @@ -154,7 +154,7 @@ getVector getA = do length <- getVarInt Vector.replicateM length getA -skipVector :: MonadGet m => m a -> m () +skipVector :: (MonadGet m) => m a -> m () skipVector getA = do length <- getVarInt replicateM_ length getA diff --git a/codebase2/util-term/U/Util/Type.hs b/codebase2/util-term/U/Util/Type.hs index 7acf6a4c14..a8eccccf05 100644 --- a/codebase2/util-term/U/Util/Type.hs +++ b/codebase2/util-term/U/Util/Type.hs @@ -61,7 +61,7 @@ flattenEffects es = [es] generalize :: (Ord v) => [v] -> TypeR r v -> TypeR r v generalize vs t = foldr f t vs where - f v t = if Set.member v (ABT.freeVars t) then forall v t else t + f v t = if Set.member v (ABT.freeVars t) then forAll v t else t -- * Patterns @@ -80,8 +80,8 @@ pattern Effect1' e t <- ABT.Tm' (Effect e t) pattern Ref' :: r -> TypeR r v pattern Ref' r <- ABT.Tm' (Ref r) -forall :: (Ord v) => v -> TypeR r v -> TypeR r v -forall v body = ABT.tm () (Forall (ABT.abs () v body)) +forAll :: (Ord v) => v -> TypeR r v -> TypeR r v +forAll v body = ABT.tm () (Forall (ABT.abs () v body)) unforall' :: TypeR r v -> ([v], TypeR r v) unforall' (ForallsNamed' vs t) = (vs, t) diff --git a/contrib/cabal.project b/contrib/cabal.project index abab30e92e..d23809d841 100644 --- a/contrib/cabal.project +++ b/contrib/cabal.project @@ -24,12 +24,13 @@ packages: lib/unison-util-relation lib/unison-util-rope lib/unison-util-file-embed - lib/unison-util-nametree parser-typechecker unison-core unison-cli + unison-cli-main unison-hashing-v2 + unison-merge unison-share-api unison-share-projects-api unison-syntax @@ -46,10 +47,12 @@ source-repository-package tag: 9275eea7982dabbf47be2ba078ced669ae7ef3d5 constraints: - fsnotify < 0.4, - crypton-x509-store <= 1.6.8, - servant <= 0.19.1, - optparse-applicative <= 0.17.1.0 + lsp == 2.3.0.0, + fsnotify == 0.4.1.0, + crypton-x509-store == 1.6.9, + servant == 0.20.1, + optparse-applicative == 0.18.1.0, + tls == 1.8.0 -- For now there is no way to apply ghc-options for all local packages -- See https://cabal.readthedocs.io/en/latest/cabal-project.html#package-configuration-options @@ -128,6 +131,9 @@ package unison-core package unison-hashing-v2 ghc-options: -Wall -Werror -Wno-name-shadowing -Wno-type-defaults -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info +package unison-merge + ghc-options: -Wall -Werror -Wno-name-shadowing -Wno-type-defaults -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info + package unison-share-api ghc-options: -Wall -Werror -Wno-name-shadowing -Wno-type-defaults -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info diff --git a/development.markdown b/development.markdown index 962a507c63..afb70842ca 100644 --- a/development.markdown +++ b/development.markdown @@ -22,7 +22,7 @@ We use 0.5.0.1 of Ormolu and CI will add an extra commit, if needed, to autoform Also note that you can always wrap a comment around some code you don't want Ormolu to touch, using: -``` +```haskell {- ORMOLU_DISABLE -} dontFormatMe = do blah blah @@ -96,11 +96,13 @@ This codebase uses symlinks as a workaround for some inconveniences in the `here First you'll need to enable "Developer Mode" in your Windows settings. - See https://consumer.huawei.com/en/support/content/en-us15594140/ +> See https://consumer.huawei.com/en/support/content/en-us15594140/ Then you'll need to enable symlink support in your `git` configuration, e.g. - `git config core.symlinks true` +```shell +git config core.symlinks true +``` And then ask `git` to fix up your symlinks with `git checkout .` @@ -113,10 +115,41 @@ Stack doesn't work deterministically in Windows due to mismatched expectations a ## Building with Nix +__NB__: It is important that the Unison Nix cache is trusted when building, otherwise you will likely end up building hundreds of packages, including GHC itself. + +The recommended way to do this is to add the public key and URL for the cache to your system’s Nix configuration. /etc/nix/nix.conf should have lines similar to +```conf +trusted-public-keys = unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k= +trusted-substituters = https://unison.cachix.org +``` +these lines could be prefixed with `extra-` and they may have additional entries besides the ones for our cache. + +This command should work if you don’t want to edit the file manually: +```shell +sudo sh -c 'echo "extra-trusted-public-keys = unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k= +extra-trusted-substituters = https://unison.cachix.org" >>/etc/nix/nix.conf' +``` +After updating /etc/nix/nix.conf, you need to restart the Nix daemon. To do this on +- Ubuntu: `sudo systemctl restart nix-daemon` +- MacOS: + ```shell + sudo launchctl unload /Library/LaunchDaemons/org.nixos.nix-daemon.plist + sudo launchctl load /Library/LaunchDaemons/org.nixos.nix-daemon.plist + ``` + +If you use NixOS, you may instead add this via your configuration.nix with +```nix +nix.settings.trusted-public-keys = ["unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k="]; +nix.settings.trusted-substituters = ["https://unison.cachix.org"]; +``` +and run `sudo nixos-rebuild switch` afterward. + +It is _not_ recommended to add your user to `trusted-users`. This _can_ make enabling flake configurations simpler (like the Unison Nix cache here), but [it is equivalent to giving that user root access (without need for sudo)](https://nix.dev/manual/nix/2.23/command-ref/conf-file.html#conf-trusted-users). + ## Building package components with nix ### Build the unison executable -``` +```shell nix build ``` @@ -125,7 +158,7 @@ This is specified with the normal `::` triple. Some examples: -``` +```shell nix build '.#component-unison-cli:lib:unison-cli' nix build '.#component-unison-syntax:test:syntax-tests' nix build '.#component-unison-cli:exe:transcripts' @@ -143,7 +176,7 @@ include: - ormolu - haskell-language-server -``` +```shell nix develop ``` @@ -153,7 +186,7 @@ versions of the compiler and other development tools. Additionally, all non-local haskell dependencies (including profiling dependencies) are provided in the nix shell. -``` +```shell nix develop '.#cabal-local' ``` @@ -163,17 +196,17 @@ versions of the compiler and other development tools. Additionally, all haskell dependencies of this package are provided by the nix shell (including profiling dependencies). -``` +```shell nix develop '.#cabal-' ``` for example: -``` +```shell nix develop '.#cabal-unison-cli' ``` or -``` +```shell nix develop '.#cabal-unison-parser-typechecker' ``` @@ -182,7 +215,7 @@ want to profile `unison-cli-main:exe:unison` then you could get into one of thes shells, cd into its directory, then run the program with profiling. -``` +```shell nix develop '.#cabal-unison-parser-typechecker' cd unison-cli cabal run --enable-profiling unison-cli-main:exe:unison -- +RTS -p diff --git a/flake.lock b/flake.lock index d4ece12a51..4c07d21e1a 100644 --- a/flake.lock +++ b/flake.lock @@ -135,51 +135,14 @@ "type": "github" } }, - "ghc98X": { - "flake": false, - "locked": { - "lastModified": 1696643148, - "narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=", - "ref": "ghc-9.8", - "rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6", - "revCount": 61642, - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - }, - "original": { - "ref": "ghc-9.8", - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - } - }, - "ghc99": { - "flake": false, - "locked": { - "lastModified": 1697054644, - "narHash": "sha256-kKarOuXUaAH3QWv7ASx+gGFMHaHKe0pK5Zu37ky2AL4=", - "ref": "refs/heads/master", - "rev": "f383a242c76f90bcca8a4d7ee001dcb49c172a9a", - "revCount": 62040, - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - }, - "original": { - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - } - }, "hackage": { "flake": false, "locked": { - "lastModified": 1699402991, - "narHash": "sha256-2nQBlA3ygBiIqVPh2J1JwP51rEO0xMjyoOaoJk5PboY=", + "lastModified": 1719535035, + "narHash": "sha256-kCCfZytGgkRYlsiNe/dwLAnpNOvfywpjVl61hO/8l2M=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "9e963602a5b3259dac9cf5e994f0a338fb352b7e", + "rev": "66f23365685f71610460f3c2c0dfa91f96c532ac", "type": "github" }, "original": { @@ -197,14 +160,16 @@ "cardano-shell": "cardano-shell", "flake-compat": "flake-compat", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", - "ghc98X": "ghc98X", - "ghc99": "ghc99", "hackage": "hackage", "hls-1.10": "hls-1.10", "hls-2.0": "hls-2.0", "hls-2.2": "hls-2.2", "hls-2.3": "hls-2.3", "hls-2.4": "hls-2.4", + "hls-2.5": "hls-2.5", + "hls-2.6": "hls-2.6", + "hls-2.7": "hls-2.7", + "hls-2.8": "hls-2.8", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", @@ -218,16 +183,17 @@ "nixpkgs-2205": "nixpkgs-2205", "nixpkgs-2211": "nixpkgs-2211", "nixpkgs-2305": "nixpkgs-2305", + "nixpkgs-2311": "nixpkgs-2311", "nixpkgs-unstable": "nixpkgs-unstable", "old-ghc-nix": "old-ghc-nix", "stackage": "stackage" }, "locked": { - "lastModified": 1699404571, - "narHash": "sha256-EwI7vKBxCHvIKPWbvGlOF9IZlSFqPODgT/BQy8Z2s/w=", + "lastModified": 1719535822, + "narHash": "sha256-IteIKK4+GEZI2nHqCz0zRVgQ3aqs/WXKTOt2sbHJmGk=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "cec253ca482301509e9e90cb5c15299dd3550cce", + "rev": "72bc84d0a4e8d0536505628040d96fd0a9e16c70", "type": "github" }, "original": { @@ -307,16 +273,84 @@ "hls-2.4": { "flake": false, "locked": { - "lastModified": 1696939266, - "narHash": "sha256-VOMf5+kyOeOmfXTHlv4LNFJuDGa7G3pDnOxtzYR40IU=", + "lastModified": 1699862708, + "narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.4.0.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.5": { + "flake": false, + "locked": { + "lastModified": 1701080174, + "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.5.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.6": { + "flake": false, + "locked": { + "lastModified": 1705325287, + "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.6.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.7": { + "flake": false, + "locked": { + "lastModified": 1708965829, + "narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.7.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.8": { + "flake": false, + "locked": { + "lastModified": 1715153580, + "narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "362fdd1293efb4b82410b676ab1273479f6d17ee", + "rev": "dd1be1beb16700de59e0d6801957290bcf956a0a", "type": "github" }, "original": { "owner": "haskell", - "ref": "2.4.0.0", + "ref": "2.8.0.0", "repo": "haskell-language-server", "type": "github" } @@ -363,18 +397,18 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1691634696, - "narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", - "ref": "hkm/remote-iserv", - "rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", - "revCount": 14, - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "lastModified": 1717479972, + "narHash": "sha256-7vE3RQycHI1YT9LHJ1/fUaeln2vIpYm6Mmn8FTpYeVo=", + "owner": "stable-haskell", + "repo": "iserv-proxy", + "rev": "2ed34002247213fc435d0062350b91bab920626e", + "type": "github" }, "original": { - "ref": "hkm/remote-iserv", - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "owner": "stable-haskell", + "ref": "iserv-syms", + "repo": "iserv-proxy", + "type": "github" } }, "lowdown-src": { @@ -512,11 +546,11 @@ }, "nixpkgs-2305": { "locked": { - "lastModified": 1695416179, - "narHash": "sha256-610o1+pwbSu+QuF3GE0NU5xQdTHM3t9wyYhB9l94Cd8=", + "lastModified": 1701362232, + "narHash": "sha256-GVdzxL0lhEadqs3hfRLuj+L1OJFGiL/L7gCcelgBlsw=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "715d72e967ec1dd5ecc71290ee072bcaf5181ed6", + "rev": "d2332963662edffacfddfad59ff4f709dde80ffe", "type": "github" }, "original": { @@ -526,6 +560,22 @@ "type": "github" } }, + "nixpkgs-2311": { + "locked": { + "lastModified": 1701386440, + "narHash": "sha256-xI0uQ9E7JbmEy/v8kR9ZQan6389rHug+zOtZeZFiDJk=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "293822e55ec1872f715a66d0eda9e592dc14419f", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-23.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-regression": { "locked": { "lastModified": 1643052045, @@ -542,35 +592,35 @@ "type": "github" } }, - "nixpkgs-unstable": { + "nixpkgs-release": { "locked": { - "lastModified": 1695318763, - "narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", + "lastModified": 1719520878, + "narHash": "sha256-5BXzNOl2RVHcfS/oxaZDKOi7gVuTyWPibQG0DHd5sSc=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e12483116b3b51a185a33a272bf351e357ba9a99", + "rev": "a44bedbb48c367f0476e6a3a27bf28f6330faf23", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-unstable", + "ref": "release-24.05", "repo": "nixpkgs", "type": "github" } }, - "nixpkgs-unstable_2": { + "nixpkgs-unstable": { "locked": { - "lastModified": 1699781429, - "narHash": "sha256-UYefjidASiLORAjIvVsUHG6WBtRhM67kTjEY4XfZOFs=", + "lastModified": 1694822471, + "narHash": "sha256-6fSDCj++lZVMZlyqOe9SIOL8tYSBz1bI8acwovRwoX8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e44462d6021bfe23dfb24b775cc7c390844f773d", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-unstable", "repo": "nixpkgs", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" } }, @@ -595,21 +645,21 @@ "inputs": { "flake-utils": "flake-utils", "haskellNix": "haskellNix", - "nixpkgs": [ + "nixpkgs-haskellNix": [ "haskellNix", "nixpkgs-unstable" ], - "nixpkgs-unstable": "nixpkgs-unstable_2" + "nixpkgs-release": "nixpkgs-release" } }, "stackage": { "flake": false, "locked": { - "lastModified": 1699402155, - "narHash": "sha256-fOywUFLuAuZAkIrv1JdjGzfY53uEiMRlu8UpdJtCjh0=", + "lastModified": 1719102283, + "narHash": "sha256-pon+cXgMWPlCiBx9GlRcjsjTHbCc8fDVgOGb3Z7qhRM=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "7c7bfe8cca23c96b850e16f3c0b159aca1850314", + "rev": "7df45e0bd9852810d8070f9c5257f8e7a4677b91", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index 8c8725da3b..a266bd2e29 100644 --- a/flake.nix +++ b/flake.nix @@ -8,17 +8,17 @@ inputs = { haskellNix.url = "github:input-output-hk/haskell.nix"; - nixpkgs.follows = "haskellNix/nixpkgs-unstable"; - nixpkgs-unstable.url = "github:NixOS/nixpkgs/nixos-unstable"; + nixpkgs-haskellNix.follows = "haskellNix/nixpkgs-unstable"; + nixpkgs-release.url = "github:NixOS/nixpkgs/release-24.05"; flake-utils.url = "github:numtide/flake-utils"; }; outputs = { self, - nixpkgs, - flake-utils, haskellNix, - nixpkgs-unstable, + nixpkgs-haskellNix, + nixpkgs-release, + flake-utils, }: flake-utils.lib.eachSystem [ "x86_64-linux" @@ -26,100 +26,60 @@ "aarch64-darwin" ] (system: let - versions = { - ghc = "928"; - ormolu = "0.5.2.0"; - hls = "2.4.0.0"; - stack = "2.13.1"; + ## It’s much easier to read from a JSON file than to have JSON import from some other file, so we extract some + ## configuration from the VS Code settings to avoid duplication. + vscodeSettings = nixpkgs-release.lib.importJSON ./.vscode/settings.json; + versions = + vscodeSettings."haskell.toolchain" + ## There are some things we want to pin that the VS Code Haskell extension doesn’t let us control. + // { hpack = "0.35.2"; + ormolu = "0.7.2.0"; }; - overlays = [ - haskellNix.overlay - (import ./nix/haskell-nix-overlay.nix) - (import ./nix/unison-overlay.nix) - ]; - pkgs = import nixpkgs { - inherit system overlays; - inherit (haskellNix) config; - }; - haskell-nix-flake = import ./nix/haskell-nix-flake.nix { - inherit pkgs versions; - inherit (nixpkgs-packages) stack hpack; - }; - unstable = import nixpkgs-unstable { + pkgs = import nixpkgs-haskellNix { inherit system; + inherit (haskellNix) config; overlays = [ - (import ./nix/unison-overlay.nix) - (import ./nix/nixpkgs-overlay.nix {inherit versions;}) + haskellNix.overlay + (import ./nix/dependencies.nix {inherit nixpkgs-release;}) ]; }; - nixpkgs-packages = let - hpkgs = unstable.haskell.packages.ghcunison; - exe = unstable.haskell.lib.justStaticExecutables; - in { - ghc = unstable.haskell.compiler."ghc${versions.ghc}"; - ormolu = exe hpkgs.ormolu; - hls = unstable.unison-hls; - stack = unstable.unison-stack; - unwrapped-stack = unstable.stack; - hpack = unstable.hpack; + unison-project = import ./nix/unison-project.nix { + inherit (nixpkgs-haskellNix) lib; + inherit (pkgs) haskell-nix; }; - nixpkgs-devShells = { - only-tools-nixpkgs = unstable.mkShell { - name = "only-tools-nixpkgs"; - buildInputs = let - build-tools = with nixpkgs-packages; [ - ghc - ormolu - hls - stack - hpack - ]; - native-packages = - pkgs.lib.optionals pkgs.stdenv.isDarwin - (with unstable.darwin.apple_sdk.frameworks; [Cocoa]); - c-deps = with unstable; [pkg-config zlib glibcLocales]; - in - build-tools ++ c-deps ++ native-packages; - shellHook = '' - export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH - ''; - }; + haskell-nix-flake = import ./nix/haskell-nix-flake.nix { + inherit pkgs unison-project versions; + inherit (nixpkgs-haskellNix) lib; }; - renameAttrs = fn: - nixpkgs.lib.mapAttrs' (name: value: { + nixpkgs-haskellNix.lib.mapAttrs' (name: value: { inherit value; name = fn name; }); in - assert nixpkgs-packages.ormolu.version == versions.ormolu; - assert nixpkgs-packages.hls.version == versions.hls; - assert nixpkgs-packages.unwrapped-stack.version == versions.stack; - assert nixpkgs-packages.hpack.version == versions.hpack; { + assert pkgs.stack.version == versions.stack; + assert pkgs.hpack.version == versions.hpack; { packages = - nixpkgs-packages - // renameAttrs (name: "component-${name}") haskell-nix-flake.packages + renameAttrs (name: "component-${name}") haskell-nix-flake.packages // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; }) // { default = haskell-nix-flake.defaultPackage; - build-tools = pkgs.symlinkJoin { - name = "build-tools"; - paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs; - }; all = pkgs.symlinkJoin { name = "all"; paths = let - all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" ["all" "build-tools"]); + all-other-packages = + builtins.attrValues (builtins.removeAttrs self.packages."${system}" [ + "all" + "docker-ucm" # this package doesn’t produce a directory + ]); devshell-inputs = builtins.concatMap (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) - [ - self.devShells."${system}".only-tools-nixpkgs - ]; + (builtins.attrValues self.devShells."${system}"); in all-other-packages ++ devshell-inputs; }; @@ -130,9 +90,8 @@ // {default = self.apps."${system}"."component-unison-cli-main:exe:unison";}; devShells = - nixpkgs-devShells - // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells - // {default = self.devShells."${system}".only-tools-nixpkgs;}; + renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells + // {default = self.devShells."${system}".cabal-local;}; checks = renameAttrs (name: "component-${name}") haskell-nix-flake.checks; diff --git a/lib/unison-prelude/src/Unison/Debug.hs b/lib/unison-prelude/src/Unison/Debug.hs index 47fdb2ee75..6bbcaa9cac 100644 --- a/lib/unison-prelude/src/Unison/Debug.hs +++ b/lib/unison-prelude/src/Unison/Debug.hs @@ -13,13 +13,12 @@ module Unison.Debug ) where -import Control.Applicative (empty) -import Control.Monad (when) -import Data.Set (Set) import Data.Set qualified as Set import Data.Text qualified as Text -import Debug.Pretty.Simple (pTrace, pTraceM, pTraceShowId, pTraceShowM) +import Debug.Pretty.Simple (pTrace, pTraceM) import System.IO.Unsafe (unsafePerformIO) +import Text.Pretty.Simple (pShow) +import Unison.Prelude import UnliftIO.Environment (lookupEnv) data DebugFlag @@ -148,7 +147,7 @@ debugPatternCoverageConstraintSolver = PatternCoverageConstraintSolver `Set.memb debug :: (Show a) => DebugFlag -> String -> a -> a debug flag msg a = if shouldDebug flag - then pTraceShowId (pTrace (msg <> ":\n") a) + then (trace (msg <> ":\n" <> into @String (pShow a)) a) else a -- | Use for selective debug logging in monadic contexts. @@ -159,8 +158,7 @@ debug flag msg a = debugM :: (Show a, Monad m) => DebugFlag -> String -> a -> m () debugM flag msg a = whenDebug flag do - pTraceM (msg <> ":\n") - pTraceShowM a + traceM (msg <> ":\n" <> into @String (pShow a)) debugLog :: DebugFlag -> String -> a -> a debugLog flag msg = diff --git a/lib/unison-prelude/src/Unison/Prelude.hs b/lib/unison-prelude/src/Unison/Prelude.hs index 0ddd4aee64..374f4a1812 100644 --- a/lib/unison-prelude/src/Unison/Prelude.hs +++ b/lib/unison-prelude/src/Unison/Prelude.hs @@ -102,7 +102,7 @@ import Witch as X (From (from), TryFrom (tryFrom), TryFromException (TryFromExce import Witherable as X (filterA, forMaybe, mapMaybe, wither, witherMap) -- | Can be removed when we upgrade transformers to a more recent version. -hoistMaybe :: Applicative m => Maybe a -> MaybeT m a +hoistMaybe :: (Applicative m) => Maybe a -> MaybeT m a hoistMaybe = MaybeT . pure -- | Like 'fold' but for Alternative. diff --git a/lib/unison-prelude/src/Unison/Util/Map.hs b/lib/unison-prelude/src/Unison/Util/Map.hs index be67d730b3..49cf1e7c36 100644 --- a/lib/unison-prelude/src/Unison/Util/Map.hs +++ b/lib/unison-prelude/src/Unison/Util/Map.hs @@ -41,7 +41,7 @@ import Data.Vector qualified as Vector import Unison.Prelude hiding (bimap, foldM, for_) -- | A common case of @Map.merge@. Like @alignWith@, but includes the key. -alignWithKey :: Ord k => (k -> These a b -> c) -> Map k a -> Map k b -> Map k c +alignWithKey :: (Ord k) => (k -> These a b -> c) -> Map k a -> Map k b -> Map k c alignWithKey f = Map.merge (Map.mapMissing \k x -> f k (This x)) @@ -60,7 +60,7 @@ bitraversed keyT valT f m = -- | Traverse a map as a list of key-value pairs. -- Note: This can have unexpected results if the result contains duplicate keys. -asList_ :: Ord k' => Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')] +asList_ :: (Ord k') => Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')] asList_ f s = s & Map.toList @@ -73,13 +73,13 @@ swap = Map.foldlWithKey' (\z a b -> Map.insert b a z) mempty -- | Like 'Map.insert', but returns the old value as well. -insertLookup :: Ord k => k -> v -> Map k v -> (Maybe v, Map k v) +insertLookup :: (Ord k) => k -> v -> Map k v -> (Maybe v, Map k v) insertLookup k v = upsertLookup (const v) k -- | Invert a map's keys and values. This probably only makes sense with injective maps, but otherwise, later key/value -- pairs (ordered by the original map's keys) overwrite earlier ones. -invert :: Ord v => Map k v -> Map v k +invert :: (Ord v) => Map k v -> Map v k invert = Map.foldlWithKey' (\m k v -> Map.insert v k m) Map.empty @@ -94,7 +94,7 @@ upsertF f = Map.alterF (fmap Just . f) -- | Like 'upsert', but returns the old value as well. -upsertLookup :: Ord k => (Maybe v -> v) -> k -> Map k v -> (Maybe v, Map k v) +upsertLookup :: (Ord k) => (Maybe v -> v) -> k -> Map k v -> (Maybe v, Map k v) upsertLookup f = upsertF (\v -> (v, f v)) @@ -113,12 +113,12 @@ deleteLookupJust = Map.alterF (maybe (error (reportBug "E525283" "deleteLookupJust: element not found")) (,Nothing)) -- | Like 'Map.elems', but return the values as a set. -elemsSet :: Ord v => Map k v -> Set v +elemsSet :: (Ord v) => Map k v -> Set v elemsSet = Set.fromList . Map.elems -- | Like 'Map.foldlWithKey'', but with a monadic accumulator. -foldM :: Monad m => (acc -> k -> v -> m acc) -> acc -> Map k v -> m acc +foldM :: (Monad m) => (acc -> k -> v -> m acc) -> acc -> Map k v -> m acc foldM f acc0 = go acc0 where @@ -141,7 +141,7 @@ foldMapM f = pure $! Map.insert k v acc -- | Run a monadic action for each key/value pair in a map. -for_ :: Monad m => Map k v -> (k -> v -> m ()) -> m () +for_ :: (Monad m) => Map k v -> (k -> v -> m ()) -> m () for_ m f = go m where diff --git a/lib/unison-prelude/src/Unison/Util/Tuple.hs b/lib/unison-prelude/src/Unison/Util/Tuple.hs index 613af47a36..c317e41ffc 100644 --- a/lib/unison-prelude/src/Unison/Util/Tuple.hs +++ b/lib/unison-prelude/src/Unison/Util/Tuple.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | Tuple utils. diff --git a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs index c19c030142..6f04fc1976 100644 --- a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs +++ b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs @@ -78,7 +78,7 @@ module Unison.Util.Pretty lineSkip, nonEmpty, numbered, - numberedColumn2, + numberedColumn2ListFrom, numberedColumn2Header, numberedColumnNHeader, numberedList, @@ -544,12 +544,12 @@ numberedHeader num ps = column2 (fmap num (Nothing : fmap Just [1 ..]) `zip` toL -- 1. one thing : this is a thing -- 2. another thing : this is another thing -- 3. and another : yet one more thing -numberedColumn2 :: - (Foldable f, LL.ListLike s Char, IsString s) => - (Int -> Pretty s) -> - f (Pretty s, Pretty s) -> - Pretty s -numberedColumn2 num ps = numbered num (align $ toList ps) +numberedColumn2ListFrom :: + (Foldable f) => + Int -> + f (Pretty ColorText, Pretty ColorText) -> + Pretty ColorText +numberedColumn2ListFrom num ps = numberedListFrom num (align $ toList ps) numberedColumn2Header :: (Foldable f, LL.ListLike s Char, IsString s) => diff --git a/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs b/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs index 294a27b5bb..ffcac47acf 100644 --- a/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs +++ b/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs @@ -4,7 +4,7 @@ import Unison.HashQualified (HashQualified) import Unison.Name (Name) import Unison.Pattern (SeqOp) import Unison.Prelude -import Unison.Referent' (Referent') +import Unison.ReferentPrime (Referent') import Unison.Util.AnnotatedText (AnnotatedText (..), annotate, segment) type SyntaxText' r = AnnotatedText (Element r) diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs index f46917ddc8..48167980db 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs @@ -151,7 +151,7 @@ logQuery (Sql sql params) result = -- Without results -execute :: Connection -> Sql -> IO () +execute :: (HasCallStack) => Connection -> Sql -> IO () execute conn@(Connection _ _ conn0) sql@(Sql s params) = do logQuery sql Nothing doExecute `catch` \(exception :: Sqlite.SQLError) -> @@ -171,8 +171,8 @@ execute conn@(Connection _ _ conn0) sql@(Sql s params) = do -- | Execute one or more semicolon-delimited statements. -- -- This function does not support parameters, and is mostly useful for executing DDL and migrations. -executeStatements :: Connection -> Text -> IO () -executeStatements conn@(Connection _ _ (Sqlite.Connection database)) sql = do +executeStatements :: (HasCallStack) => Connection -> Text -> IO () +executeStatements conn@(Connection _ _ (Sqlite.Connection database _tempNameCounter)) sql = do logQuery (Sql sql []) Nothing Direct.Sqlite.exec database sql `catch` \(exception :: Sqlite.SQLError) -> throwSqliteQueryException @@ -184,7 +184,7 @@ executeStatements conn@(Connection _ _ (Sqlite.Connection database)) sql = do -- With results, without checks -queryStreamRow :: Sqlite.FromRow a => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r +queryStreamRow :: (HasCallStack, Sqlite.FromRow a) => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r queryStreamRow conn@(Connection _ _ conn0) sql@(Sql s params) callback = run `catch` \(exception :: Sqlite.SQLError) -> throwSqliteQueryException @@ -201,7 +201,7 @@ queryStreamRow conn@(Connection _ _ conn0) sql@(Sql s params) callback = queryStreamCol :: forall a r. - (Sqlite.FromField a) => + (HasCallStack, Sqlite.FromField a) => Connection -> Sql -> (IO (Maybe a) -> IO r) -> @@ -212,7 +212,7 @@ queryStreamCol = @(Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r) queryStreamRow -queryListRow :: forall a. (Sqlite.FromRow a) => Connection -> Sql -> IO [a] +queryListRow :: forall a. (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO [a] queryListRow conn@(Connection _ _ conn0) sql@(Sql s params) = do result <- doQuery @@ -237,35 +237,35 @@ queryListRow conn@(Connection _ _ conn0) sql@(Sql s params) = do Just row -> loop (row : rows) loop [] -queryListCol :: forall a. (Sqlite.FromField a) => Connection -> Sql -> IO [a] +queryListCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO [a] queryListCol = coerce @(Connection -> Sql -> IO [Sqlite.Only a]) @(Connection -> Sql -> IO [a]) queryListRow -queryMaybeRow :: (Sqlite.FromRow a) => Connection -> Sql -> IO (Maybe a) +queryMaybeRow :: (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO (Maybe a) queryMaybeRow conn s = queryListRowCheck conn s \case [] -> Right Nothing [x] -> Right (Just x) xs -> Left (ExpectedAtMostOneRowException (anythingToString xs)) -queryMaybeCol :: forall a. (Sqlite.FromField a) => Connection -> Sql -> IO (Maybe a) +queryMaybeCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO (Maybe a) queryMaybeCol conn s = coerce @(IO (Maybe (Sqlite.Only a))) @(IO (Maybe a)) (queryMaybeRow conn s) -queryOneRow :: (Sqlite.FromRow a) => Connection -> Sql -> IO a +queryOneRow :: (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO a queryOneRow conn s = queryListRowCheck conn s \case [x] -> Right x xs -> Left (ExpectedExactlyOneRowException (anythingToString xs)) -queryOneCol :: forall a. (Sqlite.FromField a) => Connection -> Sql -> IO a +queryOneCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO a queryOneCol conn s = do coerce @(IO (Sqlite.Only a)) @(IO a) (queryOneRow conn s) -- With results, with checks queryListRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> ([a] -> Either e r) -> @@ -274,7 +274,7 @@ queryListRowCheck conn s check = gqueryListCheck conn s (mapLeft SomeSqliteExceptionReason . check) gqueryListCheck :: - (Sqlite.FromRow a) => + (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> @@ -293,7 +293,7 @@ gqueryListCheck conn sql check = do queryListColCheck :: forall a e r. - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> ([a] -> Either e r) -> @@ -302,7 +302,7 @@ queryListColCheck conn s check = queryListRowCheck conn s (coerce @([a] -> Either e r) @([Sqlite.Only a] -> Either e r) check) queryMaybeRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> @@ -315,7 +315,7 @@ queryMaybeRowCheck conn s check = queryMaybeColCheck :: forall a e r. - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> @@ -324,7 +324,7 @@ queryMaybeColCheck conn s check = queryMaybeRowCheck conn s (coerce @(a -> Either e r) @(Sqlite.Only a -> Either e r) check) queryOneRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> @@ -336,7 +336,7 @@ queryOneRowCheck conn s check = queryOneColCheck :: forall a e r. - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs index cf760c4936..e1473edfc2 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs @@ -24,7 +24,8 @@ where import Control.Concurrent (ThreadId, myThreadId) import Data.Typeable (cast) import Database.SQLite.Simple qualified as Sqlite -import GHC.Stack (currentCallStack) +import GHC.Stack (CallStack) +import GHC.Stack qualified as Stack import Unison.Prelude import Unison.Sqlite.Connection.Internal (Connection) import Unison.Sqlite.Sql (Sql (..)) @@ -112,7 +113,7 @@ data SqliteQueryException = SqliteQueryException -- | The inner exception. It is intentionally not 'SomeException', so that calling code cannot accidentally -- 'throwIO' domain-specific exception types, but must instead use a @*Check@ query variant. exception :: SomeSqliteExceptionReason, - callStack :: [String], + callStack :: CallStack, connection :: Connection, threadId :: ThreadId } @@ -137,16 +138,15 @@ data SqliteQueryExceptionInfo = SqliteQueryExceptionInfo exception :: SomeSqliteExceptionReason } -throwSqliteQueryException :: SqliteQueryExceptionInfo -> IO a +throwSqliteQueryException :: (HasCallStack) => SqliteQueryExceptionInfo -> IO a throwSqliteQueryException SqliteQueryExceptionInfo {connection, exception, sql = Sql sql params} = do threadId <- myThreadId - callStack <- currentCallStack throwIO SqliteQueryException { sql, params, exception, - callStack, + callStack = Stack.callStack, connection, threadId } diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs b/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs index 97ee636022..475cb0318a 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs @@ -193,7 +193,7 @@ sqlQQ input = Nothing -> fail ("Not in scope: " ++ Text.unpack var) Just name -> (,) <$> [|valuesSql $(TH.varE name)|] <*> [|foldMap Sqlite.Simple.toRow $(TH.varE name)|] -inSql :: Sqlite.Simple.ToField a => [a] -> Text +inSql :: (Sqlite.Simple.ToField a) => [a] -> Text inSql scalars = Text.Builder.run ("IN (" <> b_commaSep (map (\_ -> b_qmark) scalars) <> b_rparen) diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs index 49a5e01aa8..b44a04b0fa 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs @@ -66,11 +66,11 @@ newtype Transaction a -- Omit MonadThrow instance so we always throw SqliteException (via *Check) with lots of context deriving (Applicative, Functor, Monad) via (ReaderT Connection IO) -instance Monoid a => Monoid (Transaction a) where - mempty :: Monoid a => Transaction a +instance (Monoid a) => Monoid (Transaction a) where + mempty :: (Monoid a) => Transaction a mempty = pure mempty -instance Semigroup a => Semigroup (Transaction a) where +instance (Semigroup a) => Semigroup (Transaction a) where (<>) :: Transaction a -> Transaction a -> Transaction a (<>) = liftA2 (<>) @@ -88,7 +88,7 @@ instance MonadIO TransactionWithMonadIO where coerce @(IO a -> Transaction a) unsafeIO -- | Run a transaction on the given connection. -runTransaction :: (MonadIO m) => Connection -> Transaction a -> m a +runTransaction :: (MonadIO m, HasCallStack) => Connection -> Transaction a -> m a runTransaction conn (Transaction f) = liftIO do uninterruptibleMask \restore -> do Connection.begin conn @@ -117,7 +117,7 @@ instance Show RollingBack where -- | Run a transaction on the given connection, providing a function that can short-circuit (and roll back) the -- transaction. runTransactionWithRollback :: - (MonadIO m) => + (MonadIO m, HasCallStack) => Connection -> ((forall void. a -> Transaction void) -> Transaction a) -> m a @@ -137,13 +137,13 @@ runTransactionWithRollback conn transaction = liftIO do -- -- The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions. If the transaction does -- attempt a write and gets SQLITE_BUSY, it's your fault! -runReadOnlyTransaction :: (MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a +runReadOnlyTransaction :: (MonadUnliftIO m, HasCallStack) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a runReadOnlyTransaction conn f = withRunInIO \runInIO -> runReadOnlyTransaction_ conn (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runReadOnlyTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runReadOnlyTransaction_ :: Connection -> IO a -> IO a +runReadOnlyTransaction_ :: (HasCallStack) => Connection -> IO a -> IO a runReadOnlyTransaction_ conn action = do bracketOnError_ (Connection.begin conn) @@ -160,7 +160,7 @@ runReadOnlyTransaction_ conn action = do -- BEGIN/COMMIT statements. -- -- The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions. -runWriteTransaction :: (MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a +runWriteTransaction :: (HasCallStack, MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a runWriteTransaction conn f = withRunInIO \runInIO -> uninterruptibleMask \restore -> @@ -170,7 +170,7 @@ runWriteTransaction conn f = (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runWriteTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runWriteTransaction_ :: (forall x. IO x -> IO x) -> Connection -> IO a -> IO a +runWriteTransaction_ :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO a -> IO a runWriteTransaction_ restore conn transaction = do keepTryingToBeginImmediate restore conn result <- restore transaction `onException` ignoringExceptions (Connection.rollback conn) @@ -178,7 +178,7 @@ runWriteTransaction_ restore conn transaction = do pure result -- @BEGIN IMMEDIATE@ until success. -keepTryingToBeginImmediate :: (forall x. IO x -> IO x) -> Connection -> IO () +keepTryingToBeginImmediate :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO () keepTryingToBeginImmediate restore conn = let loop = try @_ @SqliteQueryException (Connection.beginImmediate conn) >>= \case @@ -217,7 +217,7 @@ savepoint (Transaction action) = do -- transaction needs to retry. -- -- /Warning/: attempting to run a transaction inside a transaction will cause an exception! -unsafeIO :: IO a -> Transaction a +unsafeIO :: (HasCallStack) => IO a -> Transaction a unsafeIO action = Transaction \_ -> action @@ -232,18 +232,18 @@ unsafeUnTransaction (Transaction action) = -- Without results -execute :: Sql -> Transaction () +execute :: (HasCallStack) => Sql -> Transaction () execute s = Transaction \conn -> Connection.execute conn s -executeStatements :: Text -> Transaction () +executeStatements :: (HasCallStack) => Text -> Transaction () executeStatements s = Transaction \conn -> Connection.executeStatements conn s -- With results, without checks queryStreamRow :: - (Sqlite.FromRow a) => + (Sqlite.FromRow a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r @@ -254,7 +254,7 @@ queryStreamRow sql callback = queryStreamCol :: forall a r. - (Sqlite.FromField a) => + (Sqlite.FromField a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r @@ -264,34 +264,34 @@ queryStreamCol = @(Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r) queryStreamRow -queryListRow :: (Sqlite.FromRow a) => Sql -> Transaction [a] +queryListRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction [a] queryListRow s = Transaction \conn -> Connection.queryListRow conn s -queryListCol :: (Sqlite.FromField a) => Sql -> Transaction [a] +queryListCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction [a] queryListCol s = Transaction \conn -> Connection.queryListCol conn s -queryMaybeRow :: (Sqlite.FromRow a) => Sql -> Transaction (Maybe a) +queryMaybeRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction (Maybe a) queryMaybeRow s = Transaction \conn -> Connection.queryMaybeRow conn s -queryMaybeCol :: (Sqlite.FromField a) => Sql -> Transaction (Maybe a) +queryMaybeCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction (Maybe a) queryMaybeCol s = Transaction \conn -> Connection.queryMaybeCol conn s -queryOneRow :: (Sqlite.FromRow a) => Sql -> Transaction a +queryOneRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction a queryOneRow s = Transaction \conn -> Connection.queryOneRow conn s -queryOneCol :: (Sqlite.FromField a) => Sql -> Transaction a +queryOneCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction a queryOneCol s = Transaction \conn -> Connection.queryOneCol conn s -- With results, with parameters, with checks queryListRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r @@ -299,7 +299,7 @@ queryListRowCheck sql check = Transaction \conn -> Connection.queryListRowCheck conn sql check queryListColCheck :: - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r @@ -307,7 +307,7 @@ queryListColCheck sql check = Transaction \conn -> Connection.queryListColCheck conn sql check queryMaybeRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r) @@ -315,7 +315,7 @@ queryMaybeRowCheck s check = Transaction \conn -> Connection.queryMaybeRowCheck conn s check queryMaybeColCheck :: - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r) @@ -323,7 +323,7 @@ queryMaybeColCheck s check = Transaction \conn -> Connection.queryMaybeColCheck conn s check queryOneRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r @@ -331,7 +331,7 @@ queryOneRowCheck s check = Transaction \conn -> Connection.queryOneRowCheck conn s check queryOneColCheck :: - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r diff --git a/lib/unison-util-bytes/test/Main.hs b/lib/unison-util-bytes/test/Main.hs index 6118703e43..98906571a4 100644 --- a/lib/unison-util-bytes/test/Main.hs +++ b/lib/unison-util-bytes/test/Main.hs @@ -42,10 +42,8 @@ test = scope "<>" . expect' $ Bytes.toArray (b1s <> b2s <> b3s) == b1 <> b2 <> b3 scope "Ord" . expect' $ - (b1 <> b2 <> b3) - `compare` b3 - == (b1s <> b2s <> b3s) - `compare` b3s + (b1 <> b2 <> b3) `compare` b3 + == (b1s <> b2s <> b3s) `compare` b3s scope "take" . expect' $ Bytes.toArray (Bytes.take k (b1s <> b2s)) == BS.take k (b1 <> b2) scope "drop" . expect' $ diff --git a/lib/unison-util-nametree/package.yaml b/lib/unison-util-nametree/package.yaml deleted file mode 100644 index fdac7c5760..0000000000 --- a/lib/unison-util-nametree/package.yaml +++ /dev/null @@ -1,56 +0,0 @@ -name: unison-util-nametree -github: unisonweb/unison -copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors - -ghc-options: -Wall - -dependencies: - - base - - containers - - lens - - semialign - - semigroups - - these - - unison-core - - unison-core1 - - unison-prelude - - unison-util-relation - -library: - source-dirs: src - when: - - condition: false - other-modules: Paths_unison_util_nametree - -default-extensions: - - BangPatterns - - BlockArguments - - DeriveAnyClass - - DeriveFoldable - - DeriveFunctor - - DeriveGeneric - - DeriveTraversable - - DerivingStrategies - - DerivingVia - - DoAndIfThenElse - - DuplicateRecordFields - - FlexibleContexts - - FlexibleInstances - - GADTs - - GeneralizedNewtypeDeriving - - ImportQualifiedPost - - InstanceSigs - - LambdaCase - - MultiParamTypeClasses - - MultiWayIf - - NamedFieldPuns - - NumericUnderscores - - OverloadedLabels - - OverloadedRecordDot - - OverloadedStrings - - PatternSynonyms - - RankNTypes - - ScopedTypeVariables - - TupleSections - - TypeApplications - - ViewPatterns diff --git a/lib/unison-util-nametree/unison-util-nametree.cabal b/lib/unison-util-nametree/unison-util-nametree.cabal deleted file mode 100644 index 80d3157ee3..0000000000 --- a/lib/unison-util-nametree/unison-util-nametree.cabal +++ /dev/null @@ -1,68 +0,0 @@ -cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.36.0. --- --- see: https://github.com/sol/hpack - -name: unison-util-nametree -version: 0.0.0 -homepage: https://github.com/unisonweb/unison#readme -bug-reports: https://github.com/unisonweb/unison/issues -copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors -build-type: Simple - -source-repository head - type: git - location: https://github.com/unisonweb/unison - -library - exposed-modules: - Unison.Util.Defns - Unison.Util.Nametree - hs-source-dirs: - src - default-extensions: - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - DerivingStrategies - DerivingVia - DoAndIfThenElse - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost - InstanceSigs - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedLabels - OverloadedRecordDot - OverloadedStrings - PatternSynonyms - RankNTypes - ScopedTypeVariables - TupleSections - TypeApplications - ViewPatterns - ghc-options: -Wall - build-depends: - base - , containers - , lens - , semialign - , semigroups - , these - , unison-core - , unison-core1 - , unison-prelude - , unison-util-relation - default-language: Haskell2010 diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs index 9167d6e6bb..5700d3f11c 100644 --- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs +++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs @@ -62,32 +62,32 @@ data BiMultimap a b = BiMultimap empty :: (Ord a, Ord b) => BiMultimap a b empty = BiMultimap mempty mempty -memberDom :: Ord a => a -> BiMultimap a b -> Bool +memberDom :: (Ord a) => a -> BiMultimap a b -> Bool memberDom x = Map.member x . domain -- | Look up the set of @b@ related to an @a@. -- -- /O(log a)/. -lookupDom :: Ord a => a -> BiMultimap a b -> Set b +lookupDom :: (Ord a) => a -> BiMultimap a b -> Set b lookupDom a = lookupDom_ a . domain -lookupDom_ :: Ord a => a -> Map a (NESet b) -> Set b +lookupDom_ :: (Ord a) => a -> Map a (NESet b) -> Set b lookupDom_ x xs = maybe Set.empty Set.NonEmpty.toSet (Map.lookup x xs) -- | Look up the @a@ related to a @b@. -- -- /O(log b)/. -lookupRan :: Ord b => b -> BiMultimap a b -> Maybe a +lookupRan :: (Ord b) => b -> BiMultimap a b -> Maybe a lookupRan b (BiMultimap _ r) = Map.lookup b r -- | Look up the @a@ related to a @b@. -- -- /O(log b)/. -unsafeLookupRan :: Ord b => b -> BiMultimap a b -> a +unsafeLookupRan :: (Ord b) => b -> BiMultimap a b -> a unsafeLookupRan b (BiMultimap _ r) = r Map.! b @@ -162,11 +162,11 @@ range = toMapR -- | Construct a left-unique relation from a mapping from its left-elements to set-of-right-elements. The caller is -- responsible for ensuring that no right-element is mapped to by two different left-elements. -unsafeFromDomain :: Ord b => Map a (NESet b) -> BiMultimap a b +unsafeFromDomain :: (Ord b) => Map a (NESet b) -> BiMultimap a b unsafeFromDomain domain = BiMultimap domain (invertDomain domain) -invertDomain :: forall a b. Ord b => Map a (NESet b) -> Map b a +invertDomain :: forall a b. (Ord b) => Map a (NESet b) -> Map b a invertDomain = Map.foldlWithKey' f Map.empty where @@ -178,6 +178,7 @@ invertDomain = g x acc y = Map.insert y x acc +-- | Construct a left-unique relation from a mapping from its right-elements to its left-elements. fromRange :: (Ord a, Ord b) => Map b a -> BiMultimap a b fromRange m = BiMultimap (Map.foldlWithKey' f Map.empty m) m @@ -215,7 +216,7 @@ insert a b m@(BiMultimap l r) = l' = Map.upsert (maybe (Set.NonEmpty.singleton b) (Set.NonEmpty.insert b)) a l -- @upsertFunc x@ returns a function that upserts @x@, suitable for passing to @Map.alterF@. -upsertFunc :: Eq a => a -> Maybe a -> (UpsertResult a, Maybe a) +upsertFunc :: (Eq a) => a -> Maybe a -> (UpsertResult a, Maybe a) upsertFunc new existing = case existing of Nothing -> (Inserted, Just new) @@ -247,7 +248,7 @@ unsafeUnion xs ys = ------------------------------------------------------------------------------------------------------------------------ -- @deriveRangeFromDomain x ys range@ is a helper that inserts @(x, y1)@, @(x, y2)@, ... into range @r@. -deriveRangeFromDomain :: Ord b => a -> NESet b -> Map b a -> Map b a +deriveRangeFromDomain :: (Ord b) => a -> NESet b -> Map b a -> Map b a deriveRangeFromDomain x ys acc = foldr (flip Map.insert x) acc ys {-# INLINE deriveRangeFromDomain #-} diff --git a/nix/dependencies.nix b/nix/dependencies.nix new file mode 100644 index 0000000000..7df873660f --- /dev/null +++ b/nix/dependencies.nix @@ -0,0 +1,21 @@ +{nixpkgs-release}: final: prev: let + pinned-pkgs = import nixpkgs-release {inherit (final) system;}; +in { + stack = pinned-pkgs.stack; + + ## See https://docs.haskellstack.org/en/stable/nix_integration/#supporting-both-nix-and-non-nix-developers for an + ## explanation of this package. + stack-wrapped = final.symlinkJoin { + name = "stack"; # will be available as the usual `stack` in terminal + paths = [final.stack]; + buildInputs = [final.makeWrapper]; + postBuild = '' + wrapProgram $out/bin/stack \ + --add-flags "\ + --no-nix \ + --system-ghc \ + --no-install-ghc \ + " + ''; + }; +} diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index c0c992ae01..ac4764c781 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -1,10 +1,10 @@ { - stack, - hpack, + lib, pkgs, + unison-project, versions, }: let - haskell-nix-flake = pkgs.unison-project.flake {}; + haskell-nix-flake = unison-project.flake {}; commonShellArgs = args: args // { @@ -12,13 +12,30 @@ # https://github.com/input-output-hk/haskell.nix/issues/1793 # https://github.com/input-output-hk/haskell.nix/issues/1885 allToolDeps = false; - additional = hpkgs: with hpkgs; [Cabal stm exceptions ghc ghc-heap]; - buildInputs = let - native-packages = - pkgs.lib.optionals pkgs.stdenv.isDarwin - (with pkgs.darwin.apple_sdk.frameworks; [Cocoa]); - in - (args.buildInputs or []) ++ [stack hpack pkgs.pkg-config pkgs.zlib pkgs.glibcLocales] ++ native-packages; + + additional = hpkgs: + (args.additional or (_: [])) hpkgs + ++ [ + hpkgs.Cabal + hpkgs.exceptions + hpkgs.ghc + hpkgs.ghc-heap + hpkgs.stm + ]; + buildInputs = + (args.buildInputs or []) + ++ [ + pkgs.glibcLocales + pkgs.zlib + ]; + nativeBuildInputs = + (args.nativeBuildInputs or []) + ++ [ + pkgs.cachix + pkgs.hpack + pkgs.pkg-config + pkgs.stack-wrapped + ]; # workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/11042 shellHook = '' export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH @@ -26,7 +43,7 @@ tools = (args.tools or {}) // { - cabal = {}; + cabal = {version = versions.cabal;}; ormolu = {version = versions.ormolu;}; haskell-language-server = { version = versions.hls; @@ -49,49 +66,42 @@ }; }; - shellFor = args: pkgs.unison-project.shellFor (commonShellArgs args); - - localPackages = with pkgs.lib; filterAttrs (k: v: v.isLocal or false) pkgs.unison-project.hsPkgs; - localPackageNames = builtins.attrNames localPackages; - devShells = let - mkDevShell = pkgName: - shellFor { - packages = hpkgs: [hpkgs."${pkgName}"]; - withHoogle = true; - }; - localPackageDevShells = - pkgs.lib.genAttrs localPackageNames mkDevShell; - in - { - only-tools = shellFor { - packages = _: []; - withHoogle = false; - }; - local = shellFor { - packages = hpkgs: (map (p: hpkgs."${p}") localPackageNames); - withHoogle = false; - }; - } - // localPackageDevShells; + shellFor = args: unison-project.shellFor (commonShellArgs args); - checks = - haskell-nix-flake.checks - // { - ## This check has a test that tries to write to $HOME, so we give it a fake one. - "unison-cli:test:cli-tests" = haskell-nix-flake.checks."unison-cli:test:cli-tests".overrideAttrs (old: { - ## The builder here doesn’t `runHook preBuild`, so we just prepend onto `buildPhase`. - buildPhase = - '' - export HOME="$TMP/fake-home" - mkdir -p "$HOME" - '' - + old.buildPhase or ""; - }); - }; + localPackages = lib.filterAttrs (k: v: v.isLocal or false) unison-project.hsPkgs; in haskell-nix-flake // { + checks = + haskell-nix-flake.checks + // { + ## This check has a test that tries to write to $HOME, so we give it a fake one. + "unison-cli:test:cli-tests" = haskell-nix-flake.checks."unison-cli:test:cli-tests".overrideAttrs (old: { + ## The builder here doesn’t `runHook preBuild`, so we just prepend onto `buildPhase`. + buildPhase = + '' + export HOME="$TMP/fake-home" + mkdir -p "$HOME" + '' + + old.buildPhase or ""; + }); + }; + defaultPackage = haskell-nix-flake.packages."unison-cli-main:exe:unison"; - inherit (pkgs) unison-project; - inherit checks devShells localPackageNames; + + devShells = let + mkDevShell = pkg: + shellFor { + packages = _hpkgs: [pkg]; + ## Enabling Hoogle causes us to rebuild GHC. + withHoogle = false; + }; + in + { + local = shellFor { + packages = _hpkgs: builtins.attrValues localPackages; + withHoogle = false; + }; + } + // pkgs.lib.mapAttrs (_name: mkDevShell) localPackages; } diff --git a/nix/haskell-nix-overlay.nix b/nix/haskell-nix-overlay.nix deleted file mode 100644 index b98ee874f2..0000000000 --- a/nix/haskell-nix-overlay.nix +++ /dev/null @@ -1,41 +0,0 @@ -final: prev: { - unison-project = with prev.lib.strings; let - cleanSource = pth: let - src' = prev.lib.cleanSourceWith { - filter = filt; - src = pth; - }; - filt = path: type: let - bn = baseNameOf path; - isHiddenFile = hasPrefix "." bn; - isFlakeLock = bn == "flake.lock"; - isNix = hasSuffix ".nix" bn; - in - !isHiddenFile && !isFlakeLock && !isNix; - in - src'; - in - final.haskell-nix.project' { - src = cleanSource ./..; - projectFileName = "stack.yaml"; - modules = [ - # enable profiling - { - enableLibraryProfiling = true; - profilingDetail = "none"; - } - # remove buggy build tool dependencies - ({lib, ...}: { - # this component has the build tool - # `unison-cli:unison` and somehow haskell.nix - # decides to add some file sharing package - # `unison` as a build-tool dependency. - packages.unison-cli.components.exes.cli-integration-tests.build-tools = lib.mkForce []; - }) - ]; - branchMap = { - "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; - "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand"; - }; - }; -} diff --git a/nix/nixpkgs-overlay.nix b/nix/nixpkgs-overlay.nix deleted file mode 100644 index 033ee5e881..0000000000 --- a/nix/nixpkgs-overlay.nix +++ /dev/null @@ -1,49 +0,0 @@ -{versions}: final: prev: { - unison-hls = final.haskell-language-server.override { - # build with our overridden haskellPackages that have our pinned - # version of ormolu and hls - haskellPackages = final.haskell.packages."ghc${versions.ghc}"; - dynamic = true; - supportedGhcVersions = [versions.ghc]; - }; - haskell = - prev.haskell - // { - packages = - prev.haskell.packages - // { - ghcunison = prev.haskell.packages."ghc${versions.ghc}".extend (hfinal: hprev: let - inherit (prev.haskell.lib) overrideCabal; - in { - # dependency overrides for ormolu 0.5.2.0 - haskell-language-server = let - p = - hfinal.callHackageDirect - { - pkg = "haskell-language-server"; - ver = versions.hls; - sha256 = "0kp586yc162raljyd5arsxm5ndcx5zfw9v94v27bkjg7x0hp1s8b"; - } - { - hls-fourmolu-plugin = null; - hls-stylish-haskell-plugin = null; - hls-hlint-plugin = null; - hls-floskell-plugin = null; - }; - override = drv: { - doCheck = false; - configureFlags = - (drv.configureFlags or []) - ++ [ - "-f-fourmolu" - "-f-stylishhaskell" - "-f-hlint" - "-f-floskell" - ]; - }; - in - overrideCabal p override; - }); - }; - }; -} diff --git a/nix/unison-overlay.nix b/nix/unison-overlay.nix deleted file mode 100644 index 5f7f1a336d..0000000000 --- a/nix/unison-overlay.nix +++ /dev/null @@ -1,15 +0,0 @@ -final: prev: { - # a wrapped version of stack that passes the necessary flags to use - # the nix provided ghc. - unison-stack = prev.symlinkJoin { - name = "stack"; - paths = [final.stack]; - buildInputs = [final.makeWrapper]; - postBuild = let - flags = ["--no-nix" "--system-ghc" "--no-install-ghc"]; - add-flags = "--add-flags '${prev.lib.concatStringsSep " " flags}'"; - in '' - wrapProgram "$out/bin/stack" ${add-flags} - ''; - }; -} diff --git a/nix/unison-project.nix b/nix/unison-project.nix new file mode 100644 index 0000000000..aa191a5a44 --- /dev/null +++ b/nix/unison-project.nix @@ -0,0 +1,31 @@ +{ + haskell-nix, + lib, +}: let + cleanSource = src: + lib.cleanSourceWith { + inherit src; + filter = path: type: let + bn = baseNameOf path; + isHiddenFile = lib.hasPrefix "." bn; + isFlakeLock = bn == "flake.lock"; + isNix = lib.hasSuffix ".nix" bn; + in + !isHiddenFile && !isFlakeLock && !isNix; + }; +in + haskell-nix.project' { + src = cleanSource ./..; + projectFileName = "stack.yaml"; + modules = [ + # enable profiling + { + enableLibraryProfiling = true; + profilingDetail = "none"; + } + ]; + 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 8bb50c5183..de5bbd70e3 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -20,7 +20,6 @@ when: dependencies: - ListLike - - NanoID - aeson - ansi-terminal - asn1-encoding @@ -81,7 +80,7 @@ dependencies: - nonempty-containers - open-browser - openapi3 - - optparse-applicative >= 0.16.1.0 + - optparse-applicative - pem - pretty-simple - primitive @@ -127,7 +126,6 @@ dependencies: - unison-util-base32hex - unison-util-bytes - unison-util-cache - - unison-util-nametree - unison-util-relation - unison-util-rope - unison-util-serialization @@ -140,9 +138,9 @@ dependencies: - warp - witch - witherable - - x509 - - x509-store - - x509-system + - crypton-x509 + - crypton-x509-store + - crypton-x509-system - yaml - zlib diff --git a/parser-typechecker/src/U/Codebase/Branch/Diff.hs b/parser-typechecker/src/U/Codebase/Branch/Diff.hs index c4a7291547..430155a4cc 100644 --- a/parser-typechecker/src/U/Codebase/Branch/Diff.hs +++ b/parser-typechecker/src/U/Codebase/Branch/Diff.hs @@ -78,7 +78,7 @@ instance (Applicative m) => Semigroup (TreeDiff m) where instance (Applicative m) => Monoid (TreeDiff m) where mempty = TreeDiff (mempty :< Compose mempty) -hoistTreeDiff :: Functor m => (forall x. m x -> n x) -> TreeDiff m -> TreeDiff n +hoistTreeDiff :: (Functor m) => (forall x. m x -> n x) -> TreeDiff m -> TreeDiff n hoistTreeDiff f (TreeDiff cfr) = TreeDiff $ Cofree.hoistCofree (\(Compose m) -> Compose (fmap f m)) cfr diff --git a/parser-typechecker/src/Unison/Builtin.hs b/parser-typechecker/src/Unison/Builtin.hs index 0c7e0514bf..1a9477fa63 100644 --- a/parser-typechecker/src/Unison/Builtin.hs +++ b/parser-typechecker/src/Unison/Builtin.hs @@ -985,7 +985,7 @@ refPromiseBuiltins = forall1 :: Text -> (Type -> Type) -> Type forall1 name body = let a = Var.named name - in Type.forall () a (body $ Type.var () a) + in Type.forAll () a (body $ Type.var () a) forall2 :: Text -> Text -> (Type -> Type -> Type) -> Type diff --git a/parser-typechecker/src/Unison/Builtin/Decls.hs b/parser-typechecker/src/Unison/Builtin/Decls.hs index b48bc44830..a918671d8d 100644 --- a/parser-typechecker/src/Unison/Builtin/Decls.hs +++ b/parser-typechecker/src/Unison/Builtin/Decls.hs @@ -174,13 +174,13 @@ rewriteCaseRef = lookupDeclRef "RewriteCase" pattern RewriteCase' :: Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a pattern RewriteCase' lhs rhs <- (unRewriteCase -> Just (lhs, rhs)) -rewriteCase :: Ord v => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a +rewriteCase :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a rewriteCase a tm1 tm2 = Term.app a (Term.app a1 (Term.constructor a1 r) tm1) tm2 where a1 = ABT.annotation tm1 r = ConstructorReference rewriteCaseRef 0 -rewriteTerm :: Ord v => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a +rewriteTerm :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a rewriteTerm a tm1 tm2 = Term.app a (Term.app a1 (Term.constructor a1 r) tm1) tm2 where a1 = ABT.annotation tm1 @@ -596,7 +596,7 @@ builtinEffectDecls = Structural () [] - [ ((), v "Exception.raise", Type.forall () (v "x") (failureType () `arr` self (var "x"))) + [ ((), v "Exception.raise", Type.forAll () (v "x") (failureType () `arr` self (var "x"))) ] pattern UnitRef :: Reference @@ -776,8 +776,8 @@ tupleTerm = foldr tupleConsTerm (unitTerm mempty) forceTerm :: (Var v) => a -> a -> Term v a -> Term v a forceTerm a au e = Term.app a e (unitTerm au) -delayTerm :: (Var v) => a -> Term v a -> Term v a -delayTerm a = Term.lam a $ Var.typed Var.Delay +delayTerm :: (Var v) => a -> a -> Term v a -> Term v a +delayTerm spanAnn argAnn = Term.lam spanAnn (argAnn, Var.typed Var.Delay) unTupleTerm :: Term.Term2 vt at ap v a -> diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 107b765c3e..a741477b0c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -1,6 +1,11 @@ module Unison.Codebase ( Codebase, + -- * UCM session state + expectCurrentProjectPath, + setCurrentProjectPath, + resolveProjectPathIds, + -- * Terms getTerm, unsafeGetTerm, @@ -43,18 +48,20 @@ module Unison.Codebase lca, SqliteCodebase.Operations.before, getShallowBranchAtPath, + getMaybeShallowBranchAtPath, getShallowCausalAtPath, - getBranchAtPath, Operations.expectCausalBranchByCausalHash, - getShallowCausalFromRoot, - getShallowRootBranch, - getShallowRootCausal, + getShallowCausalAtPathFromRootHash, + getShallowProjectBranchRoot, + expectShallowProjectBranchRoot, + getShallowBranchAtProjectPath, + getMaybeShallowBranchAtProjectPath, + getShallowProjectRootByNames, + expectProjectBranchRoot, + getBranchAtProjectPath, + preloadProjectBranch, -- * Root branch - getRootBranch, - SqliteCodebase.Operations.getRootBranchExists, - Operations.expectRootCausalHash, - putRootBranch, SqliteCodebase.Operations.namesAtPath, -- * Patches @@ -70,7 +77,10 @@ module Unison.Codebase Queries.clearWatches, -- * Reflog - Operations.getReflog, + Operations.getDeprecatedRootReflog, + Operations.getProjectBranchReflog, + Operations.getProjectReflog, + Operations.getGlobalReflog, -- * Unambiguous hash length SqliteCodebase.Operations.hashLength, @@ -103,16 +113,19 @@ module Unison.Codebase toCodeLookup, typeLookupForDependencies, unsafeGetComponentLength, + SqliteCodebase.Operations.emptyCausalHash, ) where import Data.Map qualified as Map import Data.Set qualified as Set -import U.Codebase.Branch qualified as V2 import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash) +import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Operations qualified as Operations +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Builtin qualified as Builtin import Unison.Builtin.Terms qualified as Builtin @@ -122,11 +135,13 @@ import Unison.Codebase.BuiltinAnnotation (BuiltinAnnotation (builtinAnnotation)) import Unison.Codebase.CodeLookup qualified as CL import Unison.Codebase.Path import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.Codebase.SqliteCodebase.Operations qualified as SqliteCodebase.Operations import Unison.Codebase.Type (Codebase (..)) import Unison.CodebasePath (CodebasePath, getCodebaseDir) import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.Core.Project (ProjectAndBranch) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DD import Unison.Hash (Hash) @@ -134,6 +149,7 @@ import Unison.Hashing.V2.Convert qualified as Hashing import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Parser import Unison.Prelude +import Unison.Project (ProjectAndBranch (ProjectAndBranch), ProjectBranchName, ProjectName) import Unison.Reference (Reference, TermReferenceId, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent @@ -164,72 +180,105 @@ runTransactionWithRollback :: runTransactionWithRollback Codebase {withConnection} action = withConnection \conn -> Sqlite.runTransactionWithRollback conn action -getShallowCausalFromRoot :: - -- Optional root branch, if Nothing use the codebase's root branch. - Maybe CausalHash -> +getShallowCausalAtPathFromRootHash :: + -- Causal to start at, if Nothing use the codebase's root branch. + CausalHash -> Path.Path -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -getShallowCausalFromRoot mayRootHash p = do - rootCausal <- case mayRootHash of - Nothing -> getShallowRootCausal - Just ch -> Operations.expectCausalBranchByCausalHash ch - getShallowCausalAtPath p (Just rootCausal) - --- | Get the shallow representation of the root branches without loading the children or --- history. -getShallowRootBranch :: Sqlite.Transaction (V2.Branch Sqlite.Transaction) -getShallowRootBranch = do - getShallowRootCausal >>= V2Causal.value - --- | Get the shallow representation of the root branches without loading the children or --- history. -getShallowRootCausal :: Sqlite.Transaction (V2.CausalBranch Sqlite.Transaction) -getShallowRootCausal = do - hash <- Operations.expectRootCausalHash - Operations.expectCausalBranchByCausalHash hash +getShallowCausalAtPathFromRootHash rootCausalHash p = do + rootCausal <- Operations.expectCausalBranchByCausalHash rootCausalHash + getShallowCausalAtPath p rootCausal -- | Recursively descend into causals following the given path, -- Use the root causal if none is provided. getShallowCausalAtPath :: Path -> - Maybe (V2Branch.CausalBranch Sqlite.Transaction) -> + (V2Branch.CausalBranch Sqlite.Transaction) -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -getShallowCausalAtPath path mayCausal = do - causal <- whenNothing mayCausal getShallowRootCausal +getShallowCausalAtPath path causal = do case path of Path.Empty -> pure causal ns Path.:< p -> do b <- V2Causal.value causal case V2Branch.childAt ns b of Nothing -> pure (Cv.causalbranch1to2 Branch.empty) - Just childCausal -> getShallowCausalAtPath p (Just childCausal) + Just childCausal -> getShallowCausalAtPath p childCausal -- | Recursively descend into causals following the given path, -- Use the root causal if none is provided. getShallowBranchAtPath :: Path -> - Maybe (V2Branch.Branch Sqlite.Transaction) -> + V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) -getShallowBranchAtPath path mayBranch = do - branch <- whenNothing mayBranch (getShallowRootCausal >>= V2Causal.value) +getShallowBranchAtPath path branch = fromMaybe V2Branch.empty <$> getMaybeShallowBranchAtPath path branch + +-- | Recursively descend into causals following the given path, +-- Use the root causal if none is provided. +getMaybeShallowBranchAtPath :: + Path -> + V2Branch.Branch Sqlite.Transaction -> + Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction)) +getMaybeShallowBranchAtPath path branch = do case path of - Path.Empty -> pure branch + Path.Empty -> pure $ Just branch ns Path.:< p -> do case V2Branch.childAt ns branch of - Nothing -> pure V2Branch.empty + Nothing -> pure Nothing Just childCausal -> do childBranch <- V2Causal.value childCausal - getShallowBranchAtPath p (Just childBranch) + getMaybeShallowBranchAtPath p childBranch + +-- | Recursively descend into causals following the given path, +-- Use the root causal if none is provided. +getShallowBranchAtProjectPath :: + PP.ProjectPath -> + Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) +getShallowBranchAtProjectPath pp = fromMaybe V2Branch.empty <$> getMaybeShallowBranchAtProjectPath pp --- | Get a v1 branch from the root following the given path. -getBranchAtPath :: +-- | Recursively descend into causals following the given path, +-- Use the root causal if none is provided. +getMaybeShallowBranchAtProjectPath :: + PP.ProjectPath -> + Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction)) +getMaybeShallowBranchAtProjectPath (PP.ProjectPath _project projectBranch path) = do + getShallowProjectBranchRoot projectBranch >>= \case + Nothing -> pure Nothing + Just projectRootBranch -> getMaybeShallowBranchAtPath (Path.unabsolute path) projectRootBranch + +getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (V2Branch.CausalBranch Sqlite.Transaction)) +getShallowProjectRootByNames (ProjectAndBranch projectName branchName) = runMaybeT do + ProjectBranch {projectId, branchId} <- MaybeT $ Q.loadProjectBranchByNames projectName branchName + causalHashId <- lift $ Q.expectProjectBranchHead projectId branchId + causalHash <- lift $ Q.expectCausalHash causalHashId + lift $ Operations.expectCausalBranchByCausalHash causalHash + +expectProjectBranchRoot :: (MonadIO m) => Codebase m v a -> Db.ProjectId -> Db.ProjectBranchId -> m (Branch m) +expectProjectBranchRoot codebase projectId branchId = do + causalHash <- runTransaction codebase $ do + causalHashId <- Q.expectProjectBranchHead projectId branchId + Q.expectCausalHash causalHashId + expectBranchForHash codebase causalHash + +expectShallowProjectBranchRoot :: ProjectBranch -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) +expectShallowProjectBranchRoot ProjectBranch {projectId, branchId} = do + causalHashId <- Q.expectProjectBranchHead projectId branchId + causalHash <- Q.expectCausalHash causalHashId + Operations.expectCausalBranchByCausalHash causalHash >>= V2Causal.value + +getShallowProjectBranchRoot :: ProjectBranch -> Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction)) +getShallowProjectBranchRoot ProjectBranch {projectId, branchId} = do + causalHashId <- Q.expectProjectBranchHead projectId branchId + causalHash <- Q.expectCausalHash causalHashId + Operations.loadCausalBranchByCausalHash causalHash >>= traverse V2Causal.value + +getBranchAtProjectPath :: (MonadIO m) => Codebase m v a -> - Path.Absolute -> - m (Branch m) -getBranchAtPath codebase path = do - V2Causal.Causal {causalHash} <- runTransaction codebase $ getShallowCausalAtPath (Path.unabsolute path) Nothing - expectBranchForHash codebase causalHash + PP.ProjectPath -> + m (Maybe (Branch m)) +getBranchAtProjectPath codebase pp = runMaybeT do + rootBranch <- lift $ expectProjectBranchRoot codebase pp.branch.projectId pp.branch.branchId + hoistMaybe $ Branch.getAt (pp ^. PP.path_) rootBranch -- | Like 'getBranchForHash', but for when the hash is known to be in the codebase. expectBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Branch m) @@ -509,3 +558,30 @@ unsafeGetTermComponent codebase hash = getTermComponentWithTypes codebase hash <&> \case Nothing -> error (reportBug "E769004" ("term component " ++ show hash ++ " not found")) Just terms -> terms + +expectCurrentProjectPath :: (HasCallStack) => Sqlite.Transaction PP.ProjectPath +expectCurrentProjectPath = do + (projectId, projectBranchId, path) <- Q.expectCurrentProjectPath + proj <- Q.expectProject projectId + projBranch <- Q.expectProjectBranch projectId projectBranchId + let absPath = Path.Absolute (Path.fromList path) + pure $ PP.ProjectPath proj projBranch absPath + +setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction () +setCurrentProjectPath (PP.ProjectPath projectId projectBranchId path) = + Q.setCurrentProjectPath projectId projectBranchId (Path.toList (Path.unabsolute path)) + +-- | Hydrate the project and branch from IDs. +resolveProjectPathIds :: PP.ProjectPathIds -> Sqlite.Transaction PP.ProjectPath +resolveProjectPathIds (PP.ProjectPath projectId projectBranchId path) = do + proj <- Q.expectProject projectId + projBranch <- Q.expectProjectBranch projectId projectBranchId + pure $ PP.ProjectPath proj projBranch path + +-- | Starts loading the given project branch into cache in a background thread without blocking. +preloadProjectBranch :: (MonadUnliftIO m) => Codebase m v a -> ProjectAndBranch Db.ProjectId Db.ProjectBranchId -> m () +preloadProjectBranch codebase (ProjectAndBranch projectId branchId) = do + ch <- runTransaction codebase $ do + causalHashId <- Q.expectProjectBranchHead projectId branchId + Q.expectCausalHash causalHashId + preloadBranch codebase ch diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index 2e981501c9..5213694e4a 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -90,7 +90,9 @@ module Unison.Codebase.Branch deepPaths, deepReferents, deepTermReferences, + deepTermReferenceIds, deepTypeReferences, + deepTypeReferenceIds, consBranchSnapshot, ) where @@ -136,7 +138,8 @@ import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment import Unison.Prelude hiding (empty) -import Unison.Reference (TermReference, TypeReference) +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Util.List qualified as List @@ -201,9 +204,17 @@ deepTermReferences :: Branch0 m -> Set TermReference deepTermReferences = Set.mapMaybe Referent.toTermReference . deepReferents +deepTermReferenceIds :: Branch0 m -> Set TermReferenceId +deepTermReferenceIds = + Set.mapMaybe Referent.toTermReferenceId . deepReferents + deepTypeReferences :: Branch0 m -> Set TypeReference deepTypeReferences = R.dom . deepTypes +deepTypeReferenceIds :: Branch0 m -> Set TypeReferenceId +deepTypeReferenceIds = + Set.mapMaybe Reference.toId . deepTypeReferences + namespaceStats :: Branch0 m -> NamespaceStats namespaceStats b = NamespaceStats @@ -307,7 +318,7 @@ cons = step . const -- | Construct a two-parent merge node. mergeNode :: forall m. - Applicative m => + (Applicative m) => Branch0 m -> (CausalHash, m (Branch m)) -> (CausalHash, m (Branch m)) -> diff --git a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs index d0025cd87e..e639fd41b0 100644 --- a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs +++ b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs @@ -25,7 +25,8 @@ import Unison.Codebase.Branch (Branch, Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' (HashQualified (HashQualified, NameOnly)) +import Unison.HashQualifiedPrime (HashQualified (HashQualified, NameOnly)) +import Unison.NameSegment (NameSegment) import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Prelude @@ -69,10 +70,10 @@ getBranch (p, seg) b = case Path.toList p of (Branch.head <$> Map.lookup h (b ^. Branch.children)) >>= getBranch (Path.fromList p, seg) -makeAddTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m) +makeAddTermName :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m) makeAddTermName (p, name) r = (p, Branch.addTermName r name) -makeDeleteTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m) +makeDeleteTermName :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m) makeDeleteTermName (p, name) r = (p, Branch.deleteTermName r name) makeAnnihilateTermName :: Path.Split -> (Path, Branch0 m -> Branch0 m) @@ -81,10 +82,10 @@ makeAnnihilateTermName (p, name) = (p, Branch.annihilateTermName name) makeAnnihilateTypeName :: Path.Split -> (Path, Branch0 m -> Branch0 m) makeAnnihilateTypeName (p, name) = (p, Branch.annihilateTypeName name) -makeAddTypeName :: Path.Split -> Reference -> (Path, Branch0 m -> Branch0 m) +makeAddTypeName :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m) makeAddTypeName (p, name) r = (p, Branch.addTypeName r name) -makeDeleteTypeName :: Path.Split -> Reference -> (Path, Branch0 m -> Branch0 m) +makeDeleteTypeName :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m) makeDeleteTypeName (p, name) r = (p, Branch.deleteTypeName r name) makeSetBranch :: Path.Split -> Branch m -> (Path, Branch0 m -> Branch0 m) diff --git a/parser-typechecker/src/Unison/Codebase/Causal.hs b/parser-typechecker/src/Unison/Codebase/Causal.hs index 8cca62cf05..9bdd089032 100644 --- a/parser-typechecker/src/Unison/Codebase/Causal.hs +++ b/parser-typechecker/src/Unison/Codebase/Causal.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} module Unison.Codebase.Causal - ( Causal (currentHash, head, tail, tails), + ( Causal (currentHash, valueHash, head, tail, tails), pattern One, pattern Cons, pattern Merge, @@ -40,7 +40,8 @@ import Unison.Codebase.Causal.Type currentHash, head, tail, - tails + tails, + valueHash ), before, lca, diff --git a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs index a3d5c63f51..bd352cbc26 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs @@ -1,8 +1,5 @@ module Unison.Codebase.Editor.RemoteRepo where -import Control.Lens (Lens') -import Control.Lens qualified as Lens -import Data.Void (absurd) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.NameSegment qualified as NameSegment @@ -35,12 +32,6 @@ displayShareCodeserver cs shareUser path = CustomCodeserver cu -> "share(" <> tShow cu <> ")." in shareServer <> shareUserHandleToText shareUser <> maybePrintPath path -writeNamespaceToRead :: WriteRemoteNamespace Void -> ReadRemoteNamespace void -writeNamespaceToRead = \case - WriteRemoteNamespaceShare WriteShareRemoteNamespace {server, repo, path} -> - ReadShare'LooseCode ReadShareLooseCode {server, repo, path} - WriteRemoteProjectBranch v -> absurd v - -- | print remote namespace printReadRemoteNamespace :: (a -> Text) -> ReadRemoteNamespace a -> Text printReadRemoteNamespace printProject = \case @@ -48,11 +39,8 @@ printReadRemoteNamespace printProject = \case ReadShare'ProjectBranch project -> printProject project -- | Render a 'WriteRemoteNamespace' as text. -printWriteRemoteNamespace :: WriteRemoteNamespace (ProjectAndBranch ProjectName ProjectBranchName) -> Text -printWriteRemoteNamespace = \case - WriteRemoteNamespaceShare (WriteShareRemoteNamespace {server, repo, path}) -> - displayShareCodeserver server repo path - WriteRemoteProjectBranch projectAndBranch -> into @Text projectAndBranch +printWriteRemoteNamespace :: (ProjectAndBranch ProjectName ProjectBranchName) -> Text +printWriteRemoteNamespace projectAndBranch = into @Text projectAndBranch maybePrintPath :: Path -> Text maybePrintPath path = @@ -80,28 +68,3 @@ isPublic ReadShareLooseCode {path} = case path of (segment Path.:< _) -> segment == NameSegment.publicLooseCodeSegment _ -> False - -data WriteRemoteNamespace a - = WriteRemoteNamespaceShare !WriteShareRemoteNamespace - | WriteRemoteProjectBranch a - deriving stock (Eq, Functor, Show) - --- | A lens which focuses the path of a remote namespace. -remotePath_ :: Lens' (WriteRemoteNamespace Void) Path -remotePath_ = Lens.lens getter setter - where - getter = \case - WriteRemoteNamespaceShare (WriteShareRemoteNamespace _ _ path) -> path - WriteRemoteProjectBranch v -> absurd v - setter remote path = - case remote of - WriteRemoteNamespaceShare (WriteShareRemoteNamespace server repo _) -> - WriteRemoteNamespaceShare $ WriteShareRemoteNamespace server repo path - WriteRemoteProjectBranch v -> absurd v - -data WriteShareRemoteNamespace = WriteShareRemoteNamespace - { server :: !ShareCodeserver, - repo :: !ShareUserHandle, - path :: !Path - } - deriving stock (Eq, Show) diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/parser-typechecker/src/Unison/Codebase/Execute.hs index e7f1ef0762..788bc5abe1 100644 --- a/parser-typechecker/src/Unison/Codebase/Execute.hs +++ b/parser-typechecker/src/Unison/Codebase/Execute.hs @@ -7,17 +7,22 @@ module Unison.Codebase.Execute where import Control.Exception (finally) import Control.Monad.Except +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.MainTerm (getMainTerm) import Unison.Codebase.MainTerm qualified as MainTerm +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Codebase.Runtime qualified as Runtime import Unison.HashQualified qualified as HQ -import Unison.Name (Name) -import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) +import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (toText) @@ -26,15 +31,22 @@ import Unison.Util.Pretty qualified as P execute :: Codebase.Codebase IO Symbol Ann -> Runtime Symbol -> - HQ.HashQualified Name -> + PP.ProjectPathNames -> IO (Either Runtime.Error ()) -execute codebase runtime mainName = +execute codebase runtime mainPath = (`finally` Runtime.terminate runtime) . runExceptT $ do - root <- liftIO $ Codebase.getRootBranch codebase - let parseNames = Names.makeAbsolute (Branch.toNames (Branch.head root)) - loadTypeOfTerm = Codebase.getTypeOfTerm codebase + (project, branch) <- ExceptT $ (Codebase.runTransactionWithRollback codebase) \rollback -> do + project <- Q.loadProjectByName mainPath.project `whenNothingM` rollback (Left . P.text $ ("Project not found: " <> into @Text mainPath.project)) + branch <- Q.loadProjectBranchByName project.projectId mainPath.branch `whenNothingM` rollback (Left . P.text $ ("Branch not found: " <> into @Text mainPath.branch)) + pure . Right $ (project, branch) + projectRootNames <- fmap (Branch.toNames . Branch.head) . liftIO $ Codebase.expectProjectBranchRoot codebase project.projectId branch.branchId + let loadTypeOfTerm = Codebase.getTypeOfTerm codebase let mainType = Runtime.mainType runtime - mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm parseNames mainName mainType + mainName <- case Path.toName (mainPath ^. PP.path_) of + Just n -> pure (HQ.NameOnly n) + Nothing -> throwError ("Path must lead to an executable term: " <> P.text (Path.toText (PP.path mainPath))) + + mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm projectRootNames mainName mainType case mt of MainTerm.NotFound s -> throwError ("Not found: " <> P.text (HQ.toText s)) MainTerm.BadType s _ -> throwError (P.text (HQ.toText s) <> " is not of type '{IO} ()") diff --git a/parser-typechecker/src/Unison/Codebase/MainTerm.hs b/parser-typechecker/src/Unison/Codebase/MainTerm.hs index 9f99ae5599..4c48a8a95b 100644 --- a/parser-typechecker/src/Unison/Codebase/MainTerm.hs +++ b/parser-typechecker/src/Unison/Codebase/MainTerm.hs @@ -57,7 +57,7 @@ getMainTerm loadTypeOfTerm parseNames mainName mainType = do builtinMain :: (Var v) => a -> Type.Type v a builtinMain a = let result = Var.named "result" - in Type.forall a result (builtinMainWithResultType a (Type.var a result)) + in Type.forAll a result (builtinMainWithResultType a (Type.var a result)) -- '{io2.IO, Exception} res builtinMainWithResultType :: (Var v) => a -> Type.Type v a -> Type.Type v a diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 3c20dcd852..d35a339990 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -5,7 +5,9 @@ module Unison.Codebase.Path Path' (..), Absolute (..), pattern AbsolutePath', + absPath_, Relative (..), + relPath_, pattern RelativePath', Resolve (..), pattern Empty, @@ -30,6 +32,8 @@ module Unison.Codebase.Path prefixNameIfRel, unprefixName, HQSplit, + HQSplitAbsolute, + AbsSplit, Split, Split', HQSplit', @@ -56,15 +60,15 @@ module Unison.Codebase.Path toList, toName, toName', - unsafeToName, - unsafeToName', toText, toText', + absToText, + relToText, unsplit, unsplit', unsplitAbsolute, - unsplitHQ, - unsplitHQ', + nameFromHQSplit, + nameFromHQSplit', nameFromSplit', splitFromName, splitFromName', @@ -90,7 +94,7 @@ import Data.Sequence (Seq ((:<|), (:|>))) import Data.Sequence qualified as Seq import Data.Text qualified as Text import GHC.Exts qualified as GHC -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -115,12 +119,19 @@ instance GHC.IsList Path where toList (Path segs) = Foldable.toList segs fromList = Path . Seq.fromList --- | A namespace path that starts from the root. +-- | An absolute from the current project root newtype Absolute = Absolute {unabsolute :: Path} deriving (Eq, Ord) +absPath_ :: Lens' Absolute Path +absPath_ = lens unabsolute (\_ new -> Absolute new) + -- | A namespace path that doesn’t necessarily start from the root. +-- Typically refers to a path from the current namespace. newtype Relative = Relative {unrelative :: Path} deriving (Eq, Ord) +relPath_ :: Lens' Relative Path +relPath_ = lens unrelative (\_ new -> Relative new) + -- | A namespace that may be either absolute or relative, This is the most general type that should be used. newtype Path' = Path' {unPath' :: Either Absolute Relative} deriving (Eq, Ord) @@ -150,14 +161,14 @@ absoluteToPath' = AbsolutePath' instance Show Path' where show = \case - AbsolutePath' abs -> show abs - RelativePath' rel -> show rel + AbsolutePath' abs -> Text.unpack $ absToText abs + RelativePath' rel -> Text.unpack $ relToText rel instance Show Absolute where - show s = "." ++ show (unabsolute s) + show s = Text.unpack $ absToText s instance Show Relative where - show = show . unrelative + show = Text.unpack . relToText unsplit' :: Split' -> Path' unsplit' = \case @@ -171,11 +182,13 @@ unsplitAbsolute :: (Absolute, NameSegment) -> Absolute unsplitAbsolute = coerce unsplit -unsplitHQ :: HQSplit -> HQ'.HashQualified Path -unsplitHQ (p, a) = fmap (snoc p) a +nameFromHQSplit :: HQSplit -> HQ'.HashQualified Name +nameFromHQSplit = nameFromHQSplit' . first (RelativePath' . Relative) -unsplitHQ' :: HQSplit' -> HQ'.HashQualified Path' -unsplitHQ' (p, a) = fmap (snoc' p) a +nameFromHQSplit' :: HQSplit' -> HQ'.HashQualified Name +nameFromHQSplit' (p, a) = fmap (nameFromSplit' . (p,)) a + +type AbsSplit = (Absolute, NameSegment) type Split = (Path, NameSegment) @@ -316,9 +329,6 @@ cons = Lens.cons snoc :: Path -> NameSegment -> Path snoc = Lens.snoc -snoc' :: Path' -> NameSegment -> Path' -snoc' = Lens.snoc - unsnoc :: Path -> Maybe (Path, NameSegment) unsnoc = Lens.unsnoc @@ -344,15 +354,6 @@ fromName' n where path = fromName n -unsafeToName :: Path -> Name -unsafeToName = - fromMaybe (error "empty path") . toName - --- | Convert a Path' to a Name -unsafeToName' :: Path' -> Name -unsafeToName' = - fromMaybe (error "empty path") . toName' - toName :: Path -> Maybe Name toName = \case Path Seq.Empty -> Nothing @@ -382,11 +383,29 @@ empty = Path mempty instance Show Path where show = Text.unpack . toText +instance From Path Text where + from = toText + +instance From Absolute Text where + from = absToText + +instance From Relative Text where + from = relToText + +instance From Path' Text where + from = toText' + -- | Note: This treats the path as relative. toText :: Path -> Text toText = maybe Text.empty Name.toText . toName +absToText :: Absolute -> Text +absToText abs = "." <> toText (unabsolute abs) + +relToText :: Relative -> Text +relToText rel = toText (unrelative rel) + unsafeParseText :: Text -> Path unsafeParseText = \case "" -> empty @@ -523,6 +542,9 @@ instance Resolve Absolute Relative Absolute where instance Resolve Absolute Relative Path' where resolve l r = AbsolutePath' (resolve l r) +instance Resolve Absolute Path Absolute where + resolve (Absolute l) r = Absolute (resolve l r) + instance Resolve Path' Path' Path' where resolve _ a@(AbsolutePath' {}) = a resolve (AbsolutePath' a) (RelativePath' r) = AbsolutePath' (resolve a r) diff --git a/parser-typechecker/src/Unison/Codebase/Path/Parse.hs b/parser-typechecker/src/Unison/Codebase/Path/Parse.hs index e5411d4ad3..79bb738e6d 100644 --- a/parser-typechecker/src/Unison/Codebase/Path/Parse.hs +++ b/parser-typechecker/src/Unison/Codebase/Path/Parse.hs @@ -22,7 +22,7 @@ import Text.Megaparsec qualified as P import Text.Megaparsec.Char qualified as P (char) import Text.Megaparsec.Internal qualified as P (withParsecT) import Unison.Codebase.Path -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Prelude hiding (empty, toList) import Unison.ShortHash (ShortHash) import Unison.Syntax.Lexer qualified as Lexer diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs new file mode 100644 index 0000000000..651f7f2ca5 --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -0,0 +1,136 @@ +module Unison.Codebase.ProjectPath + ( ProjectPathG (..), + ProjectPathIds, + ProjectPathNames, + ProjectPath, + fromProjectAndBranch, + projectBranchRoot, + toRoot, + absPath_, + path_, + path, + toProjectAndBranch, + projectAndBranch_, + toText, + toIds, + toNames, + projectPathParser, + parseProjectPath, + + -- * Re-exports, this also helps with using dot-notation + ProjectAndBranch (..), + Project (..), + ProjectBranch (..), + ) +where + +import Control.Lens hiding (from) +import Data.Bifoldable (Bifoldable (..)) +import Data.Bitraversable (Bitraversable (..)) +import Data.Text qualified as Text +import Text.Megaparsec qualified as Megaparsec +import Text.Megaparsec.Char qualified as Megaparsec +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.Path.Parse qualified as Path +import Unison.Prelude +import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Project qualified as Project + +data ProjectPathG proj branch = ProjectPath + { project :: proj, + branch :: branch, + absPath :: Path.Absolute + } + deriving stock (Eq, Functor, Ord, Show, Generic) + +type ProjectPathIds = ProjectPathG ProjectId ProjectBranchId + +type ProjectPathNames = ProjectPathG ProjectName ProjectBranchName + +instance From ProjectPath Text where + from = from . toNames + +instance From ProjectPathNames Text where + from (ProjectPath proj branch (Path.Absolute path)) = + into @Text (ProjectAndBranch proj branch) <> ":" <> Path.toText path + +instance From (ProjectPathG () ProjectBranchName) Text where + from (ProjectPath () branch (Path.Absolute path)) = + "/" <> into @Text branch <> ":" <> Path.toText path + +type ProjectPath = ProjectPathG Project ProjectBranch + +projectBranchRoot :: ProjectAndBranch Project ProjectBranch -> ProjectPath +projectBranchRoot (ProjectAndBranch proj branch) = ProjectPath proj branch Path.absoluteEmpty + +-- | Discard any path within the project and get the project's root +toRoot :: ProjectPath -> ProjectPath +toRoot (ProjectPath proj branch _) = ProjectPath proj branch Path.absoluteEmpty + +fromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPath +fromProjectAndBranch (ProjectAndBranch proj branch) path = ProjectPath proj branch path + +-- | Project a project context into a project path of just IDs +toIds :: ProjectPath -> ProjectPathIds +toIds (ProjectPath proj branch path) = ProjectPath (proj ^. #projectId) (branch ^. #branchId) path + +-- | Project a project context into a project path of just names +toNames :: ProjectPath -> ProjectPathNames +toNames (ProjectPath proj branch path) = ProjectPath (proj ^. #name) (branch ^. #name) path + +toProjectAndBranch :: ProjectPathG p b -> ProjectAndBranch p b +toProjectAndBranch (ProjectPath proj branch _) = ProjectAndBranch proj branch + +instance Bifunctor ProjectPathG where + bimap f g (ProjectPath p b path) = ProjectPath (f p) (g b) path + +instance Bifoldable ProjectPathG where + bifoldMap f g (ProjectPath p b _) = f p <> g b + +instance Bitraversable ProjectPathG where + bitraverse f g (ProjectPath p b path) = ProjectPath <$> f p <*> g b <*> pure path + +toText :: ProjectPathG Project ProjectBranch -> Text +toText (ProjectPath proj branch path) = + into @Text (proj ^. #name) <> "/" <> into @Text (branch ^. #name) <> ":" <> Path.absToText path + +absPath_ :: Lens' (ProjectPathG p b) Path.Absolute +absPath_ = lens absPath set + where + set (ProjectPath n b _) p = ProjectPath n b p + +path :: (ProjectPathG p b) -> Path.Path +path (ProjectPath _ _ p) = Path.unabsolute p + +path_ :: Lens' (ProjectPathG p b) Path.Path +path_ = absPath_ . Path.absPath_ + +projectAndBranch_ :: Lens (ProjectPathG p b) (ProjectPathG p' b') (ProjectAndBranch p b) (ProjectAndBranch p' b') +projectAndBranch_ = lens go set + where + go (ProjectPath proj branch _) = ProjectAndBranch proj branch + set (ProjectPath _ _ p) (ProjectAndBranch proj branch) = ProjectPath proj branch p + +type Parser = Megaparsec.Parsec Void Text + +projectPathParser :: Parser ProjectPathNames +projectPathParser = do + (projName, hasTrailingSlash) <- Project.projectNameParser + projBranchName <- Project.projectBranchNameParser (not hasTrailingSlash) + _ <- Megaparsec.char ':' + path' >>= \case + Path.AbsolutePath' p -> pure $ ProjectPath projName projBranchName p + Path.RelativePath' {} -> fail "Expected an absolute path" + where + path' :: Parser Path.Path' + path' = do + pathStr <- Megaparsec.takeRest + case Path.parsePath' (Text.unpack pathStr) of + Left err -> fail (Text.unpack err) + Right x -> pure x + +parseProjectPath :: Text -> Either Text ProjectPathNames +parseProjectPath txt = first (Text.pack . Megaparsec.errorBundlePretty) $ Megaparsec.parse projectPathParser "" txt diff --git a/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs b/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs deleted file mode 100644 index ab092c8031..0000000000 --- a/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs +++ /dev/null @@ -1,110 +0,0 @@ -module Unison.Codebase.RootBranchCache - ( RootBranchCache, - newEmptyRootBranchCache, - newEmptyRootBranchCacheIO, - fetchRootBranch, - withLock, - ) -where - -import Control.Concurrent.STM (newTVarIO) -import Control.Monad (join) -import Control.Monad.IO.Class -import Data.Coerce (coerce) -import Unison.Codebase.Branch.Type (Branch) -import Unison.Sqlite qualified as Sqlite -import UnliftIO (MonadUnliftIO, mask, onException) -import UnliftIO.STM - ( STM, - TVar, - atomically, - newTVar, - readTVar, - retrySTM, - writeTVar, - ) - -data RootBranchCacheVal - = Empty - | -- | Another thread is updating the cache. If this value is observed - -- then the reader should wait until the value is Empty or Full. The - -- api exposed from this module guarantees that a thread cannot exit - -- and leave the cache in this state. - ConcurrentModification - | Full (Branch Sqlite.Transaction) - --- This is isomorphic to @TMVar (Maybe (Branch Sqlite.Transaction))@ -newtype RootBranchCache = RootBranchCache (TVar RootBranchCacheVal) - -newEmptyRootBranchCacheIO :: (MonadIO m) => m RootBranchCache -newEmptyRootBranchCacheIO = liftIO (coerce $ newTVarIO Empty) - -newEmptyRootBranchCache :: STM RootBranchCache -newEmptyRootBranchCache = coerce (newTVar Empty) - -readRbc :: RootBranchCache -> STM RootBranchCacheVal -readRbc (RootBranchCache v) = readTVar v - -writeRbc :: RootBranchCache -> RootBranchCacheVal -> STM () -writeRbc (RootBranchCache v) x = writeTVar v x - --- | Read the root branch cache, wait if the cache is currently being --- updated -readRootBranchCache :: RootBranchCache -> STM (Maybe (Branch Sqlite.Transaction)) -readRootBranchCache v = - readRbc v >>= \case - Empty -> pure Nothing - ConcurrentModification -> retrySTM - Full x -> pure (Just x) - -fetchRootBranch :: forall m. (MonadUnliftIO m) => RootBranchCache -> m (Branch Sqlite.Transaction) -> m (Branch Sqlite.Transaction) -fetchRootBranch rbc getFromDb = mask \restore -> do - join (atomically (fetch restore)) - where - fetch :: (forall x. m x -> m x) -> STM (m (Branch Sqlite.Transaction)) - fetch restore = do - readRbc rbc >>= \case - Empty -> do - writeRbc rbc ConcurrentModification - pure do - rootBranch <- restore getFromDb `onException` atomically (writeRbc rbc Empty) - atomically (writeRbc rbc (Full rootBranch)) - pure rootBranch - ConcurrentModification -> retrySTM - Full x -> pure (pure x) - --- | Take a cache lock so that no other thread can read or write to --- the cache, perform an action with the cached value, then restore --- the cache to Empty or Full -withLock :: - forall m r. - (MonadUnliftIO m) => - RootBranchCache -> - -- | Perform an action with the cached value - ( -- restore masking state - (forall x. m x -> m x) -> - -- value retrieved from cache - Maybe (Branch Sqlite.Transaction) -> - m r - ) -> - -- | compute value to restore to the cache - (r -> Maybe (Branch Sqlite.Transaction)) -> - m r -withLock v f g = mask \restore -> do - mbranch <- atomically (takeLock v) - r <- f restore mbranch `onException` releaseLock mbranch - releaseLock (g r) - pure r - where - releaseLock :: Maybe (Branch Sqlite.Transaction) -> m () - releaseLock mbranch = - let !val = case mbranch of - Nothing -> Empty - Just x -> Full x - in atomically (writeRbc v val) - -takeLock :: RootBranchCache -> STM (Maybe (Branch Sqlite.Transaction)) -takeLock v = do - res <- readRootBranchCache v - writeRbc v ConcurrentModification - pure res diff --git a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs index 7e8b40e75b..2872ec53d2 100644 --- a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs +++ b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs @@ -10,6 +10,7 @@ where import Data.Set qualified as Set import Data.Text qualified as Text +import U.Codebase.HashTags (CausalHash (unCausalHash)) import U.Util.Base32Hex qualified as Base32Hex import Unison.Hash qualified as Hash import Unison.Prelude @@ -24,9 +25,9 @@ toString = Text.unpack . toText toHash :: (Coercible Hash.Hash h) => ShortCausalHash -> Maybe h toHash = fmap coerce . Hash.fromBase32HexText . toText -fromHash :: (Coercible h Hash.Hash) => Int -> h -> ShortCausalHash +fromHash :: Int -> CausalHash -> ShortCausalHash fromHash len = - ShortCausalHash . Text.take len . Hash.toBase32HexText . coerce + ShortCausalHash . Text.take len . Hash.toBase32HexText . unCausalHash -- | This allows a full hash to be preserved as a `ShortCausalHash`. -- @@ -47,3 +48,6 @@ fromText _ = Nothing instance Show ShortCausalHash where show (ShortCausalHash h) = '#' : Text.unpack h + +instance From ShortCausalHash Text where + from = toText diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index 18f21330e2..c104e79c87 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs @@ -18,12 +18,9 @@ import Data.Either.Extra () import Data.IORef import Data.Map qualified as Map import Data.Set qualified as Set -import Data.Time (getCurrentTime) import System.Console.ANSI qualified as ANSI import System.FileLock (SharedExclusive (Exclusive), withTryFileLock) import U.Codebase.HashTags (CausalHash, PatchHash (..)) -import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Operations qualified as Ops import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Sync22 qualified as Sync22 import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) @@ -37,10 +34,8 @@ import Unison.Codebase.Init qualified as Codebase import Unison.Codebase.Init.CreateCodebaseError qualified as Codebase1 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..)) import Unison.Codebase.Init.OpenCodebaseError qualified as Codebase1 -import Unison.Codebase.RootBranchCache import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Branch.Dependencies qualified as BD -import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.Codebase.SqliteCodebase.Migrations qualified as Migrations import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps import Unison.Codebase.SqliteCodebase.Paths @@ -59,9 +54,12 @@ import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Term (Term) import Unison.Type (Type) +import Unison.Util.Cache qualified as Cache import Unison.Util.Timing (time) import Unison.WatchKind qualified as UF import UnliftIO (UnliftIO (..), finally) +import UnliftIO qualified as UnliftIO +import UnliftIO.Concurrent qualified as UnliftIO import UnliftIO.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist) import UnliftIO.STM @@ -106,8 +104,7 @@ createCodebaseOrError onCreate debugName path lockOption action = do withConnection (debugName ++ ".createSchema") path \conn -> do Sqlite.trySetJournalMode conn Sqlite.JournalMode'WAL Sqlite.runTransaction conn do - Q.createSchema - void . Ops.saveRootBranch v2HashHandle $ Cv.causalbranch1to2 Branch.empty + CodebaseOps.createSchema onCreate sqliteCodebase debugName path Local lockOption DontMigrate action >>= \case @@ -136,7 +133,7 @@ initSchemaIfNotExist path = liftIO do createDirectoryIfMissing True (makeCodebaseDirPath path) unlessM (doesFileExist $ makeCodebasePath path) $ withConnection "initSchemaIfNotExist" path \conn -> - Sqlite.runTransaction conn Q.createSchema + Sqlite.runTransaction conn CodebaseOps.createSchema -- 1) buffer up the component -- 2) in the event that the component is complete, then what? @@ -167,8 +164,17 @@ sqliteCodebase :: (Codebase m Symbol Ann -> m r) -> m (Either Codebase1.OpenCodebaseError r) sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action = handleLockOption do - rootBranchCache <- newEmptyRootBranchCacheIO - branchCache <- newBranchCache + -- The branchLoadCache ephemerally caches branches in memory, but doesn't prevent them from being GC'd. + -- This is very useful when loading root branches because the cache shouldn't be limited in size. + -- But this cache will automatically clean itself up and remove entries that are no longer reachable. + -- If you load another branch, which shares namespaces with another branch that's in memory (and therefor in the cache) + -- then those shared namespaces will be loaded from the cache and will be shared in memory. + branchLoadCache <- newBranchCache + -- The rootBranchCache is a semispace cache which keeps the most recent branch roots (e.g. project roots) alive in memory. + -- Unlike the branchLoadCache, this cache is bounded in size and will evict older branches when it reaches its limit. + -- The two work in tandem, so the rootBranchCache keeps relevant branches alive, and the branchLoadCache + -- stores ALL the subnamespaces of those branches, deduping them when loading from the DB. + rootBranchCache <- Cache.semispaceCache 10 getDeclType <- CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType -- The v1 codebase interface has operations to read and write individual definitions -- whereas the v2 codebase writes them as complete components. These two fields buffer @@ -238,47 +244,28 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action putTypeDeclarationComponent = CodebaseOps.putTypeDeclarationComponent termBuffer declBuffer - getRootBranch :: m (Branch m) - getRootBranch = - Branch.transform runTransaction - <$> fetchRootBranch - rootBranchCache - (runTransaction (CodebaseOps.uncachedLoadRootBranch branchCache getDeclType)) - - putRootBranch :: Text -> Branch m -> m () - putRootBranch reason branch1 = do - now <- liftIO getCurrentTime - withRunInIO \runInIO -> do - -- this is naughty, the type says Transaction but it - -- won't run automatically with whatever Transaction - -- it is composed into unless the enclosing - -- Transaction is applied to the same db connection. - let branch1Trans = Branch.transform (Sqlite.unsafeIO . runInIO) branch1 - putRootBranchTrans :: Sqlite.Transaction () = do - let emptyCausalHash = Branch.headHash Branch.empty - fromRootCausalHash <- fromMaybe emptyCausalHash <$> Ops.loadRootCausalHash - let toRootCausalHash = Branch.headHash branch1 - CodebaseOps.putRootBranch branch1Trans - Ops.appendReflog (Reflog.Entry {time = now, fromRootCausalHash, toRootCausalHash, reason}) - - -- We need to update the database and the cached - -- value. We want to keep these in sync, so we take - -- the cache lock while updating sqlite. - withLock - rootBranchCache - (\restore _ -> restore $ runInIO $ runTransaction putRootBranchTrans) - (\_ -> Just branch1Trans) - -- if this blows up on cromulent hashes, then switch from `hashToHashId` -- to one that returns Maybe. getBranchForHash :: CausalHash -> m (Maybe (Branch m)) - getBranchForHash h = - fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchCache getDeclType h) + getBranchForHash = + Cache.applyDefined rootBranchCache \h -> do + fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchLoadCache getDeclType h) putBranch :: Branch m -> m () putBranch branch = withRunInIO \runInIO -> - runInIO (runTransaction (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) branch))) + runInIO $ do + Cache.insert rootBranchCache (Branch.headHash branch) branch + runTransaction (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) branch)) + + preloadBranch :: CausalHash -> m () + preloadBranch h = do + void . UnliftIO.forkIO $ void $ do + getBranchForHash h >>= \case + Nothing -> pure () + Just b -> do + UnliftIO.evaluate b + pure () syncFromDirectory :: Codebase1.CodebasePath -> Branch m -> m () syncFromDirectory srcRoot b = @@ -334,8 +321,6 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action putTypeDeclaration, putTypeDeclarationComponent, getTermComponentWithTypes, - getRootBranch, - putRootBranch, getBranchForHash, putBranch, syncFromDirectory, @@ -347,7 +332,8 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action filterTermsByReferentIdHavingTypeImpl, termReferentsByPrefix = referentsByPrefix, withConnection = withConn, - withConnectionIO = withConnection debugName root + withConnectionIO = withConnection debugName root, + preloadBranch } Right <$> action codebase where diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 68dc7c0a9f..9052e5511a 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -21,6 +21,7 @@ import Unison.Codebase.Init.OpenCodebaseError qualified as Codebase import Unison.Codebase.IntegrityCheck (IntegrityResult (..), integrityCheckAllBranches, integrityCheckAllCausals, prettyPrintIntegrityErrors) import Unison.Codebase.SqliteCodebase.Migrations.Helpers (abortMigration) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 (migrateSchema11To12) +import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 (migrateSchema1To2) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema3To4 (migrateSchema3To4) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema5To6 (migrateSchema5To6) @@ -30,27 +31,28 @@ import Unison.Codebase.SqliteCodebase.Operations qualified as Ops2 import Unison.Codebase.SqliteCodebase.Paths (backupCodebasePath) import Unison.Codebase.Type (LocalOrRemote (..)) import Unison.ConstructorType qualified as CT +import Unison.Debug qualified as Debug import Unison.Hash (Hash) import Unison.Prelude import Unison.Sqlite qualified as Sqlite import Unison.Sqlite.Connection qualified as Sqlite.Connection import Unison.Util.Monoid (foldMapM) -import Unison.Util.Monoid qualified as Monoid import Unison.Util.Pretty qualified as Pretty import UnliftIO qualified -- | Mapping from schema version to the migration required to get there. -- E.g. The migration at index 2 must be run on a codebase at version 1. migrations :: + (MVar Region.ConsoleRegion) -> -- | A 'getDeclType'-like lookup, possibly backed by a cache. (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) -> TVar (Map Hash Ops2.TermBufferEntry) -> TVar (Map Hash Ops2.DeclBufferEntry) -> CodebasePath -> - Map SchemaVersion (Sqlite.Transaction ()) -migrations getDeclType termBuffer declBuffer rootCodebasePath = + Map SchemaVersion (Sqlite.Connection -> IO ()) +migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath = Map.fromList - [ (2, migrateSchema1To2 getDeclType termBuffer declBuffer), + [ (2, runT $ migrateSchema1To2 getDeclType termBuffer declBuffer), -- The 1 to 2 migration kept around hash objects of hash version 1, unfortunately this -- caused an issue: -- @@ -67,30 +69,34 @@ migrations getDeclType termBuffer declBuffer rootCodebasePath = -- This migration drops all the v1 hash objects to avoid this issue, since these hash objects -- weren't being used for anything anyways. sqlMigration 3 (Q.removeHashObjectsByHashingVersion (HashVersion 1)), - (4, migrateSchema3To4), + (4, runT (migrateSchema3To4 *> runIntegrityChecks regionVar)), -- The 4 to 5 migration adds initial support for out-of-order sync i.e. Unison Share sqlMigration 5 Q.addTempEntityTables, - (6, migrateSchema5To6 rootCodebasePath), - (7, migrateSchema6To7), - (8, migrateSchema7To8), + (6, runT $ migrateSchema5To6 rootCodebasePath), + (7, runT (migrateSchema6To7 *> runIntegrityChecks regionVar)), + (8, runT migrateSchema7To8), -- Recreates the name lookup tables because the primary key was missing the root hash id. sqlMigration 9 Q.fixScopedNameLookupTables, sqlMigration 10 Q.addProjectTables, sqlMigration 11 Q.addMostRecentBranchTable, - (12, migrateSchema11To12), + (12, runT migrateSchema11To12), sqlMigration 13 Q.addMostRecentNamespaceTable, sqlMigration 14 Q.addSquashResultTable, sqlMigration 15 Q.addSquashResultTableIfNotExists, - sqlMigration 16 Q.cdToProjectRoot + sqlMigration 16 Q.cdToProjectRoot, + (17 {- This migration takes a raw sqlite connection -}, \conn -> migrateSchema16To17 conn) ] where - sqlMigration :: SchemaVersion -> Sqlite.Transaction () -> (SchemaVersion, Sqlite.Transaction ()) + runT :: Sqlite.Transaction () -> Sqlite.Connection -> IO () + runT t conn = Sqlite.runWriteTransaction conn (\run -> run t) + sqlMigration :: SchemaVersion -> Sqlite.Transaction () -> (SchemaVersion, Sqlite.Connection -> IO ()) sqlMigration ver migration = ( ver, - do - Q.expectSchemaVersion (ver - 1) - migration - Q.setSchemaVersion ver + \conn -> Sqlite.runWriteTransaction conn \run -> run + do + Q.expectSchemaVersion (ver - 1) + migration + Q.setSchemaVersion ver ) data CodebaseVersionStatus @@ -109,9 +115,9 @@ checkCodebaseIsUpToDate = do -- The highest schema that this ucm knows how to migrate to. pure $ if - | schemaVersion == Q.currentSchemaVersion -> CodebaseUpToDate - | schemaVersion < Q.currentSchemaVersion -> CodebaseRequiresMigration schemaVersion Q.currentSchemaVersion - | otherwise -> CodebaseUnknownSchemaVersion schemaVersion + | schemaVersion == Q.currentSchemaVersion -> CodebaseUpToDate + | schemaVersion < Q.currentSchemaVersion -> CodebaseRequiresMigration schemaVersion Q.currentSchemaVersion + | otherwise -> CodebaseUnknownSchemaVersion schemaVersion -- | Migrates a codebase up to the most recent version known to ucm. -- This is a No-op if it's up to date @@ -140,7 +146,7 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh Region.displayConsoleRegions do (`UnliftIO.finally` finalizeRegion) do - let migs = migrations getDeclType termBuffer declBuffer root + let migs = migrations regionVar getDeclType termBuffer declBuffer root -- The highest schema that this ucm knows how to migrate to. let highestKnownSchemaVersion = fst . head $ Map.toDescList migs currentSchemaVersion <- Sqlite.runTransaction conn Q.schemaVersion @@ -149,11 +155,10 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh when shouldPrompt do putStrLn "Press to start the migration once all other ucm processes are shutdown..." void $ liftIO getLine - ranMigrations <- - Sqlite.runWriteTransaction conn \run -> do + ranMigrations <- do + currentSchemaVersion <- Sqlite.runTransaction conn $ do -- Get the schema version again now that we're in a transaction. - currentSchemaVersion <- run Q.schemaVersion - let migrationsToRun = Map.filterWithKey (\v _ -> v > currentSchemaVersion) migs + Q.schemaVersion -- This is a bit of a hack, hopefully we can remove this when we have a more -- reliable way to freeze old migration code in time. -- The problem is that 'saveObject' has been changed to flush temp entity tables, @@ -163,48 +168,29 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh -- -- Hopefully we can remove this once we've got better methods of freezing migration -- code in time. - when (currentSchemaVersion < 5) $ run Q.addTempEntityTables - when (currentSchemaVersion < 6) $ run Q.addNamespaceStatsTables - for_ (Map.toAscList migrationsToRun) $ \(SchemaVersion v, migration) -> do - putStrLn $ "🔨 Migrating codebase to version " <> show v <> "..." - run migration - let ranMigrations = not (null migrationsToRun) - when ranMigrations do - region <- - UnliftIO.mask_ do - region <- Region.openConsoleRegion Region.Linear - putMVar regionVar region - pure region - result <- do - -- Ideally we'd check everything here, but certain codebases are known to have objects - -- with missing Hash Objects, we'll want to clean that up in a future migration. - -- integrityCheckAllHashObjects, - let checks = - Monoid.whenM - (currentSchemaVersion < 7) -- Only certain migrations actually make changes which reasonably need to be checked - [ integrityCheckAllBranches, - integrityCheckAllCausals - ] - - zip [(1 :: Int) ..] checks & foldMapM \(i, check) -> do - Region.setConsoleRegion - region - (Text.pack (printf "🕵️ Checking codebase integrity (step %d of %d)..." i (length checks))) - run check - case result of - NoIntegrityErrors -> pure () - IntegrityErrorDetected errs -> do - let msg = prettyPrintIntegrityErrors errs - let rendered = Pretty.toPlain 80 (Pretty.border 2 msg) - Region.setConsoleRegion region (Text.pack rendered) - run (abortMigration "Codebase integrity error detected.") - pure ranMigrations + when (currentSchemaVersion < 5) Q.addTempEntityTables + when (currentSchemaVersion < 6) Q.addNamespaceStatsTables + pure currentSchemaVersion + let migrationsToRun = Map.filterWithKey (\v _ -> v > currentSchemaVersion) migs + for_ (Map.toAscList migrationsToRun) $ \(SchemaVersion v, migration) -> do + putStrLn $ "🔨 Migrating codebase to version " <> show v <> "..." + migration conn + let ranMigrations = not (null migrationsToRun) + pure ranMigrations + Debug.debugLogM Debug.Migration "Migrations complete" when ranMigrations do - region <- readMVar regionVar + region <- + UnliftIO.mask_ do + region <- Region.openConsoleRegion Region.Linear + putMVar regionVar region + pure region -- Vacuum once now that any migrations have taken place. Region.setConsoleRegion region ("✅ All good, cleaning up..." :: Text) case vacuumStrategy of - Vacuum -> void $ Sqlite.Connection.vacuum conn + Vacuum -> do + Debug.debugLogM Debug.Migration "About to VACUUM" + void $ Sqlite.Connection.vacuum conn + Debug.debugLogM Debug.Migration "Done VACUUM" NoVacuum -> pure () Region.setConsoleRegion region ("🏁 Migrations complete 🏁" :: Text) @@ -224,3 +210,34 @@ backupCodebaseIfNecessary backupStrategy localOrRemote conn currentSchemaVersion Sqlite.trySetJournalMode backupConn Sqlite.JournalMode'WAL putStrLn ("📋 I backed up your codebase to " ++ (root backupPath)) putStrLn "⚠️ Please close all other ucm processes and wait for the migration to complete before interacting with your codebase." + +runIntegrityChecks :: + (MVar Region.ConsoleRegion) -> + Sqlite.Transaction () +runIntegrityChecks regionVar = do + region <- Sqlite.unsafeIO . UnliftIO.mask_ $ do + region <- Region.openConsoleRegion Region.Linear + putMVar regionVar region + pure region + result <- do + -- Ideally we'd check everything here, but certain codebases are known to have objects + -- with missing Hash Objects, we'll want to clean that up in a future migration. + -- integrityCheckAllHashObjects, + let checks = + [ integrityCheckAllBranches, + integrityCheckAllCausals + ] + + zip [(1 :: Int) ..] checks & foldMapM \(i, check) -> do + Sqlite.unsafeIO $ + Region.setConsoleRegion + region + (Text.pack (printf "🕵️ Checking codebase integrity (step %d of %d)..." i (length checks))) + check + case result of + NoIntegrityErrors -> pure () + IntegrityErrorDetected errs -> do + let msg = prettyPrintIntegrityErrors errs + let rendered = Pretty.toPlain 80 (Pretty.border 2 msg) + Sqlite.unsafeIO $ Region.setConsoleRegion region (Text.pack rendered) + (abortMigration "Codebase integrity error detected.") diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs new file mode 100644 index 0000000000..7771c08291 --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -0,0 +1,269 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) where + +import Control.Lens +import Data.Aeson qualified as Aeson +import Data.Map qualified as Map +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text +import Data.UUID (UUID) +import Data.UUID qualified as UUID +import U.Codebase.Branch.Type qualified as V2Branch +import U.Codebase.Causal qualified as V2Causal +import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId (..), ProjectId (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.SqliteCodebase.Branch.Cache qualified as BranchCache +import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps +import Unison.Codebase.SqliteCodebase.Operations qualified as Ops +import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (UnsafeProjectName)) +import Unison.Debug qualified as Debug +import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment +import Unison.Prelude +import Unison.Sqlite qualified as Sqlite +import Unison.Sqlite.Connection qualified as Connection +import Unison.Syntax.NameSegment qualified as NameSegment +import UnliftIO qualified +import UnliftIO qualified as UnsafeIO + +-- | This migration converts the codebase from having all projects in a single codebase root to having separate causal +-- roots for each project branch. +-- It: +-- +-- * Adds the new project reflog table +-- * Adds the project-branch head as a causal-hash-id column on the project-branch table, and populates it from all the projects in the project root. +-- * Makes a new legacy project from the existing root branch (minus .__projects) +-- * Adds a new scratch/main project +-- * Adds a currentProjectPath table to replace the most-recent-path functionality. +-- +-- It requires a Connection argument rather than working inside a Transaction because it needs to temporarily disable +-- foreign key checking, and the foreign_key pragma cannot be set within a transaction. +migrateSchema16To17 :: Sqlite.Connection -> IO () +migrateSchema16To17 conn = withDisabledForeignKeys $ do + Q.expectSchemaVersion 16 + Q.addProjectBranchReflogTable + Debug.debugLogM Debug.Migration "Adding causal hashes to project branches table." + addCausalHashesToProjectBranches + Debug.debugLogM Debug.Migration "Making legacy project from loose code." + makeLegacyProjectFromLooseCode + Debug.debugLogM Debug.Migration "Adding scratch project" + scratchMain <- + Q.loadProjectBranchByNames scratchProjectName scratchBranchName >>= \case + Just pb -> pure pb + Nothing -> do + (_, emptyCausalHashId) <- Codebase.emptyCausalHash + (_proj, pb) <- Ops.insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId + pure pb + + -- Try to set the recent project branch to what it was, default back to scratch if it doesn't exist or the user is in + -- loose code. + mayRecentProjectBranch <- runMaybeT $ do + (projectId, branchId) <- MaybeT getMostRecentProjectBranchIds + -- Make sure the project-branch still exists. + _projBranch <- MaybeT $ Q.loadProjectBranch projectId branchId + pure (projectId, branchId) + + Debug.debugLogM Debug.Migration "Adding current project path table" + Q.addCurrentProjectPathTable + Debug.debugLogM Debug.Migration "Setting current project path to scratch project" + + case mayRecentProjectBranch of + Just (projectId, branchId) -> + Q.setCurrentProjectPath projectId branchId [] + Nothing -> Q.setCurrentProjectPath scratchMain.projectId scratchMain.branchId [] + Debug.debugLogM Debug.Migration "Done migrating to version 17" + Q.setSchemaVersion 17 + where + scratchProjectName = UnsafeProjectName "scratch" + scratchBranchName = UnsafeProjectBranchName "main" + withDisabledForeignKeys :: Sqlite.Transaction r -> IO r + withDisabledForeignKeys m = do + let disable = Connection.execute conn [Sqlite.sql| PRAGMA foreign_keys=OFF |] + let enable = Connection.execute conn [Sqlite.sql| PRAGMA foreign_keys=ON |] + let action = Sqlite.runWriteTransaction conn \run -> run $ m + UnsafeIO.bracket disable (const enable) (const action) + +data ForeignKeyFailureException + = ForeignKeyFailureException + -- We leave the data as raw as possible to ensure we can display it properly rather than get decoding errors while + -- trying to display some other error. + [[Sqlite.SQLData]] + | MissingRootBranch + deriving stock (Show) + deriving anyclass (Exception) + +addCausalHashesToProjectBranches :: Sqlite.Transaction () +addCausalHashesToProjectBranches = do + Debug.debugLogM Debug.Migration "Creating new_project_branch" + -- Create the new version of the project_branch table with the causal_hash_id column. + Sqlite.execute + [Sqlite.sql| +CREATE TABLE new_project_branch ( + project_id uuid NOT NULL REFERENCES project (id), + branch_id uuid NOT NULL, + name text NOT NULL, + causal_hash_id integer NOT NULL REFERENCES causal(self_hash_id), + + primary key (project_id, branch_id), + + unique (project_id, name) +) +without rowid; +|] + rootCausalHashId <- expectNamespaceRoot + rootCh <- Q.expectCausalHash rootCausalHashId + projectsRoot <- Codebase.getShallowCausalAtPathFromRootHash rootCh (Path.singleton $ projectsNameSegment) >>= V2Causal.value + ifor_ (V2Branch.children projectsRoot) \projectIdNS projectsCausal -> do + projectId <- case projectIdNS of + UUIDNameSegment projectIdUUID -> pure $ ProjectId projectIdUUID + _ -> error $ "Invalid Project Id NameSegment:" <> show projectIdNS + Debug.debugM Debug.Migration "Migrating project" projectId + projectsBranch <- V2Causal.value projectsCausal + case (Map.lookup branchesNameSegment $ V2Branch.children projectsBranch) of + Nothing -> pure () + Just branchesCausal -> do + branchesBranch <- V2Causal.value branchesCausal + ifor_ (V2Branch.children branchesBranch) \branchIdNS projectBranchCausal -> void . runMaybeT $ do + projectBranchId <- case branchIdNS of + UUIDNameSegment branchIdUUID -> pure $ ProjectBranchId branchIdUUID + _ -> error $ "Invalid Branch Id NameSegment:" <> show branchIdNS + Debug.debugM Debug.Migration "Migrating project branch" projectBranchId + let branchCausalHash = V2Causal.causalHash projectBranchCausal + causalHashId <- lift $ Q.expectCausalHashIdByCausalHash branchCausalHash + branchName <- + MaybeT $ + Sqlite.queryMaybeCol @ProjectBranchName + [Sqlite.sql| + SELECT project_branch.name + FROM project_branch + WHERE + project_branch.project_id = :projectId + AND project_branch.branch_id = :projectBranchId + |] + -- Insert the full project branch with HEAD into the new table + lift $ + Sqlite.execute + [Sqlite.sql| + INSERT INTO new_project_branch (project_id, branch_id, name, causal_hash_id) + VALUES (:projectId, :projectBranchId, :branchName, :causalHashId) + |] + + Debug.debugLogM Debug.Migration "Deleting orphaned project branch data" + -- Delete any project branch data that don't have a matching branch in the current root. + -- This is to make sure any old or invalid project branches get cleared out and won't cause problems when we rewrite + -- foreign key references. + -- We have to do this manually since we had to disable foreign key checks to add the new column. + Sqlite.execute + [Sqlite.sql| DELETE FROM project_branch_parent AS pbp + WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbp.project_id AND npb.branch_id = pbp.branch_id) + |] + Debug.debugLogM Debug.Migration "Deleting orphaned remote mapping data" + Sqlite.execute + [Sqlite.sql| DELETE FROM project_branch_remote_mapping AS pbrp + WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbrp.local_project_id AND npb.branch_id = pbrp.local_branch_id) + |] + -- Delete any project branch rows that don't have a matching branch in the current root. + Sqlite.execute + [Sqlite.sql| + DELETE FROM most_recent_branch AS mrb + WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = mrb.project_id AND npb.branch_id = mrb.branch_id) + |] + + Debug.debugLogM Debug.Migration "Swapping old and new project branch tables" + -- Drop the old project_branch table and rename the new one to take its place. + Sqlite.execute [Sqlite.sql| DROP TABLE project_branch |] + Sqlite.execute [Sqlite.sql| ALTER TABLE new_project_branch RENAME TO project_branch |] + Debug.debugLogM Debug.Migration "Checking foreign keys" + foreignKeyErrs <- Sqlite.queryListRow [Sqlite.sql| PRAGMA foreign_key_check |] + when (not . null $ foreignKeyErrs) . Sqlite.unsafeIO . UnliftIO.throwIO $ ForeignKeyFailureException foreignKeyErrs + +makeLegacyProjectFromLooseCode :: Sqlite.Transaction () +makeLegacyProjectFromLooseCode = do + rootChId <- + Sqlite.queryOneCol @CausalHashId + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + rootCh <- Q.expectCausalHash rootChId + branchCache <- Sqlite.unsafeIO BranchCache.newBranchCache + getDeclType <- Sqlite.unsafeIO $ CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType + rootBranch <- + CodebaseOps.getBranchForHash branchCache getDeclType rootCh `whenNothingM` do + Sqlite.unsafeIO . UnliftIO.throwIO $ MissingRootBranch + -- Remove the hidden projects root if one existed. + let rootWithoutProjects = rootBranch & over (Branch.head_ . Branch.children) (Map.delete projectsNameSegment) + CodebaseOps.putBranch rootWithoutProjects + let legacyBranchRootHash = Branch.headHash rootWithoutProjects + legacyBranchRootHashId <- Q.expectCausalHashIdByCausalHash legacyBranchRootHash + + let findLegacyName :: Maybe Int -> Sqlite.Transaction ProjectName + findLegacyName mayN = do + let tryProjName = case mayN of + Nothing -> UnsafeProjectName "legacy" + Just n -> UnsafeProjectName $ "legacy" <> Text.pack (show n) + Q.loadProjectBranchByNames tryProjName legacyBranchName >>= \case + Nothing -> pure tryProjName + Just _ -> findLegacyName . Just $ maybe 1 succ mayN + legacyProjName <- findLegacyName Nothing + void $ Ops.insertProjectAndBranch legacyProjName legacyBranchName legacyBranchRootHashId + pure () + where + legacyBranchName = UnsafeProjectBranchName "main" + +expectNamespaceRoot :: Sqlite.Transaction CausalHashId +expectNamespaceRoot = + Sqlite.queryOneCol loadNamespaceRootSql + +loadNamespaceRootSql :: Sqlite.Sql +loadNamespaceRootSql = + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + +pattern UUIDNameSegment :: UUID -> NameSegment +pattern UUIDNameSegment uuid <- + ( NameSegment.toUnescapedText -> + (Text.uncons -> Just ('_', UUID.fromText . Text.map (\c -> if c == '_' then '-' else c) -> Just uuid)) + ) + where + UUIDNameSegment uuid = + NameSegment (Text.cons '_' (Text.map (\c -> if c == '-' then '_' else c) (UUID.toText uuid))) + +projectsNameSegment :: NameSegment +projectsNameSegment = NameSegment.unsafeParseText "__projects" + +branchesNameSegment :: NameSegment +branchesNameSegment = NameSegment.unsafeParseText "branches" + +expectMostRecentNamespace :: Sqlite.Transaction [NameSegment] +expectMostRecentNamespace = + Sqlite.queryOneColCheck + [Sqlite.sql| + SELECT namespace + FROM most_recent_namespace + |] + check + where + check :: Text -> Either Q.JsonParseFailure [NameSegment] + check bytes = + case Aeson.eitherDecodeStrict (Text.encodeUtf8 bytes) of + Left failure -> Left (Q.JsonParseFailure {bytes, failure = Text.pack failure}) + Right namespace -> Right (map NameSegment namespace) + +getMostRecentProjectBranchIds :: Sqlite.Transaction (Maybe (ProjectId, ProjectBranchId)) +getMostRecentProjectBranchIds = do + nameSegments <- expectMostRecentNamespace + case nameSegments of + (proj : UUIDNameSegment projectId : branches : UUIDNameSegment branchId : _) + | proj == projectsNameSegment && branches == branchesNameSegment -> + pure . Just $ (ProjectId projectId, ProjectBranchId branchId) + _ -> pure Nothing diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs index 475e19d338..066c4c03a9 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 @@ -72,7 +73,7 @@ import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent' +import Unison.ReferentPrime qualified as Referent' import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Term qualified as Term @@ -103,7 +104,7 @@ migrateSchema1To2 getDeclType termBuffer declBuffer = do log "I'll go ahead with the migration, but will replace any corrupted namespaces with empty ones." log "Updating Namespace Root..." - rootCausalHashId <- Q.expectNamespaceRoot + rootCausalHashId <- expectNamespaceRoot numEntitiesToMigrate <- sum <$> sequenceA [Q.countObjects, Q.countCausals, Q.countWatches] v2EmptyBranchHashInfo <- saveV2EmptyBranch watches <- @@ -115,7 +116,7 @@ migrateSchema1To2 getDeclType termBuffer declBuffer = do `execStateT` MigrationState Map.empty Map.empty Map.empty Set.empty 0 v2EmptyBranchHashInfo let (_, newRootCausalHashId) = causalMapping migrationState ^?! ix rootCausalHashId log "Updating Namespace Root..." - Q.setNamespaceRoot newRootCausalHashId + setNamespaceRoot newRootCausalHashId log "Rewriting old object IDs..." ifor_ (objLookup migrationState) \oldObjId (newObjId, _, _, _) -> do Q.recordObjectRehash oldObjId newObjId @@ -149,6 +150,23 @@ migrateSchema1To2 getDeclType termBuffer declBuffer = do allDone = lift $ log $ "\nFinished migrating, initiating cleanup." in Sync.Progress {need, done, error = errorHandler, allDone} +expectNamespaceRoot :: Sqlite.Transaction CausalHashId +expectNamespaceRoot = + Sqlite.queryOneCol loadNamespaceRootSql + +loadNamespaceRootSql :: Sqlite.Sql +loadNamespaceRootSql = + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + +setNamespaceRoot :: CausalHashId -> Sqlite.Transaction () +setNamespaceRoot id = + Sqlite.queryOneCol [Sqlite.sql| SELECT EXISTS (SELECT 1 FROM namespace_root) |] >>= \case + False -> Sqlite.execute [Sqlite.sql| INSERT INTO namespace_root VALUES (:id) |] + True -> Sqlite.execute [Sqlite.sql| UPDATE namespace_root SET causal_id = :id |] + log :: String -> Sqlite.Transaction () log = Sqlite.unsafeIO . putStrLn diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs index 57dbdea27b..b68ee1541e 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs @@ -81,7 +81,7 @@ numMigrated = migrateSchema3To4 :: Sqlite.Transaction () migrateSchema3To4 = do Q.expectSchemaVersion 3 - rootCausalHashId <- Q.expectNamespaceRoot + rootCausalHashId <- expectNamespaceRoot totalCausals <- causalCount migrationState <- flip execStateT (MigrationState mempty mempty 0) $ Sync.sync migrationSync (migrationProgress totalCausals) [rootCausalHashId] let MigrationState {_canonicalBranchForCausalHashId = mapping} = migrationState @@ -98,6 +98,17 @@ migrateSchema3To4 = do SELECT count(*) FROM causal; |] +expectNamespaceRoot :: Sqlite.Transaction DB.CausalHashId +expectNamespaceRoot = + Sqlite.queryOneCol loadNamespaceRootSql + +loadNamespaceRootSql :: Sqlite.Sql +loadNamespaceRootSql = + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + migrationProgress :: Int -> Sync.Progress (StateT MigrationState Sqlite.Transaction) DB.CausalHashId migrationProgress totalCausals = Sync.Progress {Sync.need, Sync.done, Sync.error, Sync.allDone} diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs index 9395c3919d..2fa0205484 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs @@ -1,11 +1,14 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema5To6 (migrateSchema5To6) where +import Data.Bitraversable import Data.Text qualified as Text import Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) import System.FilePath (()) import U.Codebase.HashTags (CausalHash (CausalHash)) import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Operations qualified as Ops import U.Codebase.Sqlite.Queries qualified as Q import Unison.Codebase (CodebasePath) import Unison.Hash qualified as Hash @@ -30,12 +33,21 @@ migrateCurrentReflog codebasePath = do -- so we check first to avoid triggering a bad foreign key constraint. haveFrom <- isJust <$> Q.loadCausalByCausalHash (Reflog.fromRootCausalHash oldEntry) haveTo <- isJust <$> Q.loadCausalByCausalHash (Reflog.toRootCausalHash oldEntry) - when (haveFrom && haveTo) $ Ops.appendReflog oldEntry + when (haveFrom && haveTo) $ appendReflog oldEntry Sqlite.unsafeIO . putStrLn $ "I migrated old reflog entries from " <> reflogPath <> " into the codebase; you may delete that file now if you like." where reflogPath :: FilePath reflogPath = codebasePath "reflog" + appendReflog :: Reflog.Entry CausalHash Text -> Sqlite.Transaction () + appendReflog entry = do + dbEntry <- (bitraverse Q.saveCausalHash pure) entry + Sqlite.execute + [Sqlite.sql| + INSERT INTO reflog (time, from_root_causal_id, to_root_causal_id, reason) + VALUES (@dbEntry, @, @, @) + |] + oldReflogEntries :: CodebasePath -> UTCTime -> IO [Reflog.Entry CausalHash Text] oldReflogEntries reflogPath now = ( do diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs index b62708f70c..f09ff8559c 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs @@ -4,7 +4,6 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema6To7 (migrateSchema6To7) where -import Control.Monad.Except import Control.Monad.State import U.Codebase.Branch.Type (NamespaceStats) import U.Codebase.Sqlite.DbId qualified as DB diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index 98a6db75ef..050d7f5fda 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} -- | This module contains sqlite-specific operations on high-level "parser-typechecker" types all in the Transaction -- monad. @@ -16,6 +18,7 @@ import Data.List.NonEmpty.Extra (NonEmpty ((:|)), maximum1) import Data.Map qualified as Map import Data.Maybe (fromJust) import Data.Set qualified as Set +import Data.UUID.V4 qualified as UUID import U.Codebase.Branch qualified as V2Branch import U.Codebase.Branch.Diff (TreeDiff (TreeDiff)) import U.Codebase.Branch.Diff qualified as BranchDiff @@ -30,11 +33,14 @@ import U.Codebase.Sqlite.NamedRef qualified as S import U.Codebase.Sqlite.ObjectType qualified as OT import U.Codebase.Sqlite.Operations (NamesInPerspective (..)) import U.Codebase.Sqlite.Operations qualified as Ops +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.Project qualified as Project import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) import Unison.Builtin qualified as Builtins import Unison.Codebase.Branch (Branch (..)) +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Patch (Patch) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path @@ -43,7 +49,7 @@ import Unison.Codebase.SqliteCodebase.Branch.Cache (BranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT -import Unison.Core.Project (ProjectBranchName, ProjectName) +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl import Unison.Hash (Hash) @@ -74,6 +80,35 @@ import Unison.Util.Set qualified as Set import Unison.WatchKind qualified as UF import UnliftIO.STM +createSchema :: Transaction () +createSchema = do + Q.runCreateSql + Q.addTempEntityTables + Q.addNamespaceStatsTables + Q.addReflogTable + Q.fixScopedNameLookupTables + Q.addProjectTables + Q.addMostRecentBranchTable + Q.addNameLookupMountTables + Q.addMostRecentNamespaceTable + Sqlite.execute insertSchemaVersionSql + Q.addSquashResultTable + Q.addCurrentProjectPathTable + Q.addProjectBranchReflogTable + Q.addProjectBranchCausalHashIdColumn + (_, emptyCausalHashId) <- emptyCausalHash + (_, ProjectBranch {projectId, branchId}) <- insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId + Q.setCurrentProjectPath projectId branchId [] + where + scratchProjectName = UnsafeProjectName "scratch" + scratchBranchName = UnsafeProjectBranchName "main" + currentSchemaVersion = Q.currentSchemaVersion + insertSchemaVersionSql = + [Sqlite.sql| + INSERT INTO schema_version (version) + VALUES (:currentSchemaVersion) + |] + ------------------------------------------------------------------------------------------------------------------------ -- Buffer entry @@ -382,25 +417,6 @@ tryFlushDeclBuffer termBuffer declBuffer = h in loop -uncachedLoadRootBranch :: - BranchCache Sqlite.Transaction -> - (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) -> - Transaction (Branch Transaction) -uncachedLoadRootBranch branchCache getDeclType = do - causal2 <- Ops.expectRootCausal - Cv.causalbranch2to1 branchCache getDeclType causal2 - --- | Get whether the root branch exists. -getRootBranchExists :: Transaction Bool -getRootBranchExists = - isJust <$> Ops.loadRootCausalHash - -putRootBranch :: Branch Transaction -> Transaction () -putRootBranch branch1 = do - -- todo: check to see if root namespace hash has been externally modified - -- and do something (merge?) it if necessary. But for now, we just overwrite it. - void (Ops.saveRootBranch v2HashHandle (Cv.causalbranch1to2 branch1)) - -- if this blows up on cromulent hashes, then switch from `hashToHashId` -- to one that returns Maybe. getBranchForHash :: @@ -735,14 +751,34 @@ makeMaybeCachedTransaction size action = do conn <- Sqlite.unsafeGetConnection Sqlite.unsafeIO (Cache.applyDefined cache (\x -> Sqlite.unsafeUnTransaction (action x) conn) x) -insertProjectAndBranch :: Db.ProjectId -> ProjectName -> Db.ProjectBranchId -> ProjectBranchName -> Sqlite.Transaction () -insertProjectAndBranch projectId projectName branchId branchName = do - Q.insertProject projectId projectName +-- | Creates a project by name if one doesn't already exist, creates a branch in that project, then returns the project and branch ids. Fails if a branch by that name already exists in the project. +insertProjectAndBranch :: ProjectName -> ProjectBranchName -> Db.CausalHashId -> Sqlite.Transaction (Project, ProjectBranch) +insertProjectAndBranch projectName branchName chId = do + projectId <- whenNothingM (fmap Project.projectId <$> Q.loadProjectByName projectName) do + projectId <- Sqlite.unsafeIO (Db.ProjectId <$> UUID.nextRandom) + Q.insertProject projectId projectName + pure projectId + branchId <- Sqlite.unsafeIO (Db.ProjectBranchId <$> UUID.nextRandom) + let projectBranch = + ProjectBranch + { projectId, + branchId, + name = branchName, + parentBranchId = Nothing + } Q.insertProjectBranch - ProjectBranch - { projectId, - branchId, - name = branchName, - parentBranchId = Nothing - } + "Project Created" + chId + projectBranch Q.setMostRecentBranch projectId branchId + pure (Project {name = projectName, projectId}, ProjectBranch {projectId, name = branchName, branchId, parentBranchId = Nothing}) + +-- | Often we need to assign something to an empty causal, this ensures the empty causal +-- exists in the codebase and returns its hash. +emptyCausalHash :: Sqlite.Transaction (CausalHash, Db.CausalHashId) +emptyCausalHash = do + let emptyBranch = Branch.empty + putBranch emptyBranch + let causalHash = Branch.headHash emptyBranch + causalHashId <- Q.expectCausalHashIdByCausalHash causalHash + pure (causalHash, causalHashId) diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs index 0b803dd73a..af69f555cd 100644 --- a/parser-typechecker/src/Unison/Codebase/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Type.hs @@ -55,13 +55,6 @@ data Codebase m v a = Codebase putTypeDeclarationComponent :: Hash -> [Decl v a] -> Sqlite.Transaction (), -- getTermComponent :: Hash -> m (Maybe [Term v a]), getTermComponentWithTypes :: Hash -> Sqlite.Transaction (Maybe [(Term v a, Type v a)]), - -- | Get the root branch. - getRootBranch :: m (Branch m), - -- | Like 'putBranch', but also adjusts the root branch pointer afterwards. - putRootBranch :: - Text -> -- Reason for the change, will be recorded in the reflog - Branch m -> - m (), getBranchForHash :: CausalHash -> m (Maybe (Branch m)), -- | Put a branch into the codebase, which includes its children, its patches, and the branch itself, if they don't -- already exist. @@ -87,7 +80,12 @@ data Codebase m v a = Codebase -- | Acquire a new connection to the same underlying database file this codebase object connects to. withConnection :: forall x. (Sqlite.Connection -> m x) -> m x, -- | Acquire a new connection to the same underlying database file this codebase object connects to. - withConnectionIO :: forall x. (Sqlite.Connection -> IO x) -> IO x + withConnectionIO :: forall x. (Sqlite.Connection -> IO x) -> IO x, + -- | This optimization allows us to pre-fetch a branch from SQLite into the branch cache when we know we'll need it + -- soon, but not immediately. E.g. the user has switched a branch, but hasn't run any commands on it yet. + -- + -- This combinator returns immediately, but warms the cache in the background with the desired branch. + preloadBranch :: CausalHash -> m () } -- | Whether a codebase is local or remote. diff --git a/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs b/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs index d2e9aa5bcf..649a629cdc 100644 --- a/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs +++ b/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs @@ -10,6 +10,7 @@ import U.Codebase.Branch qualified as Codebase.Branch import U.Codebase.Decl qualified as Codebase.Decl import U.Codebase.Reference qualified as Codebase.Reference import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Sqlite qualified as Sqlite @@ -21,8 +22,8 @@ import Witherable (witherM) -- For (potential) efficiency, this function accepts an argument that loads a namespace at a path, which may be backed -- by a cache. loadUniqueTypeGuid :: - ([NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))) -> - [NameSegment] -> + (ProjectPath -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))) -> + ProjectPath -> NameSegment -> Sqlite.Transaction (Maybe Text) loadUniqueTypeGuid loadNamespaceAtPath path name = diff --git a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs index 0a218b0c34..59d168b2e1 100644 --- a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs +++ b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs @@ -40,7 +40,7 @@ import Unison.Var qualified as Var -- -- Note that we can't actually tell whether the Decl was originally a record or not, so we -- include all possible accessors, but they may or may not exist in the codebase. -labeledDeclDependenciesIncludingSelfAndFieldAccessors :: Var v => TypeReference -> (DD.Decl v a) -> Set LD.LabeledDependency +labeledDeclDependenciesIncludingSelfAndFieldAccessors :: (Var v) => TypeReference -> (DD.Decl v a) -> Set LD.LabeledDependency labeledDeclDependenciesIncludingSelfAndFieldAccessors selfRef decl = DD.labeledDeclDependenciesIncludingSelf selfRef decl <> case decl of diff --git a/parser-typechecker/src/Unison/KindInference.hs b/parser-typechecker/src/Unison/KindInference.hs index 8265f042b0..081b758690 100644 --- a/parser-typechecker/src/Unison/KindInference.hs +++ b/parser-typechecker/src/Unison/KindInference.hs @@ -79,7 +79,7 @@ inferDecls ppe declMap = -- | Break the decls into strongly connected components in reverse -- topological order -intoComponents :: forall v a. Ord v => Map Reference (Decl v a) -> [[(Reference, Decl v a)]] +intoComponents :: forall v a. (Ord v) => Map Reference (Decl v a) -> [[(Reference, Decl v a)]] intoComponents declMap = let graphInput :: [(Decl v a, Reference, [Reference])] graphInput = Map.foldrWithKey (\k a b -> (a, k, declReferences a) : b) [] declMap diff --git a/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs b/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs index 5f261aa2cb..27609d13f8 100644 --- a/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs +++ b/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs @@ -43,7 +43,7 @@ prettyArrow prec lhs rhs = in wrap (lhs <> " -> " <> rhs) prettyCyclicSolvedConstraint :: - Var v => + (Var v) => Solved.Constraint (UVar v loc) v loc -> Int -> Map (UVar v loc) (P.Pretty P.ColorText) -> @@ -62,7 +62,7 @@ prettyCyclicSolvedConstraint constraint prec nameMap visitingSet = case constrai pure (prettyArrow prec pa pb, cyclicLhs <> cyclicRhs) prettyCyclicUVarKindWorker :: - Var v => + (Var v) => Int -> UVar v loc -> Map (UVar v loc) (P.Pretty P.ColorText) -> @@ -78,11 +78,11 @@ prettyCyclicUVarKindWorker prec u nameMap visitingSet = -- | Pretty print the kind constraint on the given @UVar@. -- -- __Precondition:__ The @ConstraintMap@ is acyclic. -prettyUVarKind :: Var v => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> P.Pretty P.ColorText +prettyUVarKind :: (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> P.Pretty P.ColorText prettyUVarKind ppe constraints uvar = ppRunner ppe constraints do prettyUVarKind' arrPrec uvar -prettyUVarKind' :: Var v => Int -> UVar v loc -> Solve v loc (P.Pretty P.ColorText) +prettyUVarKind' :: (Var v) => Int -> UVar v loc -> Solve v loc (P.Pretty P.ColorText) prettyUVarKind' prec u = find u >>= \case Nothing -> pure (prettyUnknown prec) @@ -92,7 +92,7 @@ prettyUVarKind' prec u = -- -- __Precondition:__ The @ConstraintMap@ is acyclic. prettySolvedConstraint :: - Var v => + (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> Solved.Constraint (UVar v loc) v loc -> @@ -100,7 +100,7 @@ prettySolvedConstraint :: prettySolvedConstraint ppe constraints c = ppRunner ppe constraints (prettySolvedConstraint' arrPrec c) -prettySolvedConstraint' :: Var v => Int -> Solved.Constraint (UVar v loc) v loc -> Solve v loc (P.Pretty P.ColorText) +prettySolvedConstraint' :: (Var v) => Int -> Solved.Constraint (UVar v loc) v loc -> Solve v loc (P.Pretty P.ColorText) prettySolvedConstraint' prec = \case Solved.IsAbility _ -> pure (prettyAbility prec) Solved.IsType _ -> pure (prettyType prec) @@ -113,7 +113,7 @@ prettySolvedConstraint' prec = \case -- constraint map, but no constraints are added. This runner just -- allows running pretty printers outside of the @Solve@ monad by -- discarding the resulting state. -ppRunner :: Var v => PrettyPrintEnv -> ConstraintMap v loc -> (forall r. Solve v loc r -> r) +ppRunner :: (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> (forall r. Solve v loc r -> r) ppRunner ppe constraints = let st = SolveState @@ -130,7 +130,7 @@ ppRunner ppe constraints = -- -- __Precondition:__ The @UVar@ has a cyclic constraint. prettyCyclicUVarKind :: - Var v => + (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> diff --git a/parser-typechecker/src/Unison/KindInference/Error.hs b/parser-typechecker/src/Unison/KindInference/Error.hs index 2e977e0493..e9d0900a0a 100644 --- a/parser-typechecker/src/Unison/KindInference/Error.hs +++ b/parser-typechecker/src/Unison/KindInference/Error.hs @@ -28,7 +28,7 @@ data ConstraintConflict v loc = ConstraintConflict' conflictedConstraint :: Solved.Constraint (UVar v loc) v loc } -lspLoc :: Semigroup loc => KindError v loc -> loc +lspLoc :: (Semigroup loc) => KindError v loc -> loc lspLoc = \case CycleDetected loc _ _ -> loc UnexpectedArgument _ abs arg _ -> varLoc abs <> varLoc arg @@ -45,30 +45,30 @@ data KindError v loc CycleDetected loc (UVar v loc) (ConstraintMap v loc) | -- | Something of kind * or Effect is applied to an argument UnexpectedArgument + -- | src span of abs loc - -- ^ src span of abs + -- | abs var (UVar v loc) - -- ^ abs var + -- | arg var (UVar v loc) - -- ^ arg var - (ConstraintMap v loc) - -- ^ context + -- | context -- | An arrow kind is applied to a type, but its kind doesn't match -- the expected argument kind + (ConstraintMap v loc) | ArgumentMismatch + -- | abs var (UVar v loc) - -- ^ abs var + -- | expected var (UVar v loc) - -- ^ expected var + -- | given var (UVar v loc) - -- ^ given var - (ConstraintMap v loc) - -- ^ context + -- | context -- | Same as @ArgumentMismatch@, but for applications to the builtin -- @Arrow@ type. + (ConstraintMap v loc) | ArgumentMismatchArrow + -- | (The applied arrow range, lhs, rhs) (loc, Type v loc, Type v loc) - -- ^ (The applied arrow range, lhs, rhs) (ConstraintConflict v loc) (ConstraintMap v loc) | -- | Something appeared in an effect list that isn't of kind Effect @@ -77,22 +77,22 @@ data KindError v loc (ConstraintMap v loc) | -- | Generic constraint conflict ConstraintConflict + -- | Failed to add this constraint (GeneratedConstraint v loc) - -- ^ Failed to add this constraint + -- | Due to this conflict (ConstraintConflict v loc) - -- ^ Due to this conflict + -- | in this context (ConstraintMap v loc) - -- ^ in this context -- | Transform generic constraint conflicts into more specific error -- by examining its @ConstraintContext@. -improveError :: Var v => KindError v loc -> Solve v loc (KindError v loc) +improveError :: (Var v) => KindError v loc -> Solve v loc (KindError v loc) improveError = \case ConstraintConflict a b c -> improveError' a b c e -> pure e improveError' :: - Var v => + (Var v) => GeneratedConstraint v loc -> ConstraintConflict v loc -> ConstraintMap v loc -> diff --git a/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs b/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs index b1db1ac911..cf14da1ad6 100644 --- a/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs +++ b/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs @@ -17,7 +17,7 @@ import Unison.Var (Var) -- | Pretty print a user-facing @KindError@. prettyKindError :: - Var v => + (Var v) => -- | How to print types (Type v loc -> Pretty ColorText) -> -- | How to print source spans diff --git a/parser-typechecker/src/Unison/KindInference/Generate.hs b/parser-typechecker/src/Unison/KindInference/Generate.hs index b235108745..ab675534d2 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate.hs @@ -106,7 +106,7 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do effConstraints <- typeConstraintTree effKind eff pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints -handleIntroOuter :: Var v => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r +handleIntroOuter :: (Var v) => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r handleIntroOuter v loc k = do let typ = Type.var loc v new <- freshVar typ @@ -171,7 +171,7 @@ dfAnns annAlg cons nil = ABT.cata \ann abt0 -> case abt0 of -- Our rewrite signature machinery generates type annotations that are -- not well kinded. Work around this for now by stripping those -- annotations. -hackyStripAnns :: Ord v => Term.Term v loc -> Term.Term v loc +hackyStripAnns :: (Ord v) => Term.Term v loc -> Term.Term v loc hackyStripAnns = snd . ABT.cata \ann abt0 -> case abt0 of ABT.Var v -> (False, ABT.var ann v) diff --git a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs index 7b374d6efa..4271665beb 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs @@ -52,7 +52,7 @@ run :: Gen v loc a -> GenState v loc -> (a, GenState v loc) run (Gen ma) st0 = ma st0 -- | Create a unique @UVar@ associated with @typ@ -freshVar :: Var v => T.Type v loc -> Gen v loc (UVar v loc) +freshVar :: (Var v) => T.Type v loc -> Gen v loc (UVar v loc) freshVar typ = do st@GenState {unifVars, newVars} <- get let var :: Symbol @@ -63,7 +63,7 @@ freshVar typ = do pure uvar -- | Associate a fresh @UVar@ with @t@, push onto context -pushType :: Var v => T.Type v loc -> Gen v loc (UVar v loc) +pushType :: (Var v) => T.Type v loc -> Gen v loc (UVar v loc) pushType t = do GenState {typeMap} <- get (var, newTypeMap) <- @@ -75,13 +75,13 @@ pushType t = do pure var -- | Lookup the @UVar@ associated with a @Type@ -lookupType :: Var v => T.Type v loc -> Gen v loc (Maybe (UVar v loc)) +lookupType :: (Var v) => T.Type v loc -> Gen v loc (Maybe (UVar v loc)) lookupType t = do GenState {typeMap} <- get pure (NonEmpty.head <$> Map.lookup t typeMap) -- | Remove a @Type@ from the context -popType :: Var v => T.Type v loc -> Gen v loc () +popType :: (Var v) => T.Type v loc -> Gen v loc () popType t = do modify \st -> st {typeMap = del (typeMap st)} where @@ -94,7 +94,7 @@ popType t = do in Map.alter f t m -- | Helper to run an action with the given @Type@ in the context -scopedType :: Var v => T.Type v loc -> (UVar v loc -> Gen v loc r) -> Gen v loc r +scopedType :: (Var v) => T.Type v loc -> (UVar v loc -> Gen v loc r) -> Gen v loc r scopedType t m = do s <- pushType t r <- m s diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 1bf58960f5..623152972a 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -89,7 +89,7 @@ step e st cs = Right () -> Right finalState -- | Default any unconstrained vars to @Type@ -defaultUnconstrainedVars :: Var v => SolveState v loc -> SolveState v loc +defaultUnconstrainedVars :: (Var v) => SolveState v loc -> SolveState v loc defaultUnconstrainedVars st = let newConstraints = foldl' phi (constraints st) (newUnifVars st) phi b a = U.alter a handleNothing handleJust b @@ -167,8 +167,7 @@ reduce cs0 = dbg "reduce" cs0 (go False []) -- contradictory constraint. addConstraint :: forall v loc. - Ord loc => - Var v => + (Ord loc, Var v) => GeneratedConstraint v loc -> Solve v loc (Either (KindError v loc) ()) addConstraint constraint = do @@ -200,8 +199,7 @@ addConstraint constraint = do -- satisfied. addConstraint' :: forall v loc. - Ord loc => - Var v => + (Ord loc, Var v) => UnsolvedConstraint v loc -> Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc]) addConstraint' = \case @@ -304,7 +302,7 @@ union _unionLoc a b = do -- | Do an occurence check and return an error or the resulting solve -- state verify :: - Var v => + (Var v) => SolveState v loc -> Either (NonEmpty (KindError v loc)) (SolveState v loc) verify st = @@ -347,7 +345,7 @@ assertGen gen = do -- | occurence check and report any errors occCheck :: forall v loc. - Var v => + (Var v) => ConstraintMap v loc -> Either (NonEmpty (KindError v loc)) (ConstraintMap v loc) occCheck constraints0 = @@ -401,7 +399,7 @@ data OccCheckState v loc = OccCheckState kindErrors :: [KindError v loc] } -markVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) CycleCheck +markVisiting :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) CycleCheck markVisiting x = do OccCheckState {visitingSet, visitingStack} <- M.get case Set.member x visitingSet of @@ -420,7 +418,7 @@ markVisiting x = do } pure NoCycle -unmarkVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) () +unmarkVisiting :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) () unmarkVisiting x = M.modify \st -> st { visitingSet = Set.delete x (visitingSet st), @@ -431,7 +429,7 @@ unmarkVisiting x = M.modify \st -> addError :: KindError v loc -> M.State (OccCheckState v loc) () addError ke = M.modify \st -> st {kindErrors = ke : kindErrors st} -isSolved :: Var v => UVar v loc -> M.State (OccCheckState v loc) Bool +isSolved :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) Bool isSolved x = do OccCheckState {solvedSet} <- M.get pure $ Set.member x solvedSet @@ -444,7 +442,7 @@ data CycleCheck -- Debug output helpers -------------------------------------------------------------------------------- -prettyConstraintD' :: Show loc => Var v => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText +prettyConstraintD' :: (Show loc, Var v) => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText prettyConstraintD' ppe = P.wrap . \case Unsolved.IsType v p -> prettyUVar ppe v <> " ~ Type" <> prettyProv p @@ -455,10 +453,10 @@ prettyConstraintD' ppe = prettyProv x = "[" <> P.string (show x) <> "]" -prettyConstraints :: Show loc => Var v => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText +prettyConstraints :: (Show loc, Var v) => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText prettyConstraints ppe = P.sep "\n" . map (prettyConstraintD' ppe) -prettyUVar :: Var v => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText +prettyUVar :: (Var v) => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText prettyUVar ppe (UVar s t) = TP.pretty ppe t <> " :: " <> P.prettyVar s tracePretty :: P.Pretty P.ColorText -> a -> a diff --git a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs index d0d8fc58fb..21cd38b95e 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs @@ -14,6 +14,7 @@ module Unison.KindInference.Solve.Monad where import Control.Lens (Lens', (%%~)) +import Control.Monad.Fix (MonadFix (..)) import Control.Monad.Reader qualified as M import Control.Monad.State.Strict qualified as M import Data.Functor.Identity @@ -64,7 +65,7 @@ newtype Solve v loc a = Solve {unSolve :: Env -> SolveState v loc -> (a, SolveSt ( Functor, Applicative, Monad, - M.MonadFix, + MonadFix, M.MonadReader Env, M.MonadState (SolveState v loc) ) @@ -87,7 +88,7 @@ genStateL f st = } -- | Interleave constraint generation into constraint solving -runGen :: Var v => Gen v loc a -> Solve v loc a +runGen :: (Var v) => Gen v loc a -> Solve v loc a runGen gena = do st <- M.get let gena' = do @@ -103,7 +104,7 @@ runGen gena = do -- | Add a unification variable to the constarint mapping with no -- constraints. This is done on uvars created during constraint -- generation to initialize the new uvars (see 'runGen'). -addUnconstrainedVar :: Var v => UVar v loc -> Solve v loc () +addUnconstrainedVar :: (Var v) => UVar v loc -> Solve v loc () addUnconstrainedVar uvar = do st@SolveState {constraints} <- M.get let constraints' = U.insert uvar Descriptor {descriptorConstraint = Nothing} constraints @@ -124,7 +125,7 @@ emptyState = } -- | Lookup the constraints associated with a unification variable -find :: Var v => UVar v loc -> Solve v loc (Maybe (Constraint (UVar v loc) v loc)) +find :: (Var v) => UVar v loc -> Solve v loc (Maybe (Constraint (UVar v loc) v loc)) find k = do st@SolveState {constraints} <- M.get case U.lookupCanon k constraints of diff --git a/parser-typechecker/src/Unison/Parsers.hs b/parser-typechecker/src/Unison/Parsers.hs index 0e985764d9..fc1500a12f 100644 --- a/parser-typechecker/src/Unison/Parsers.hs +++ b/parser-typechecker/src/Unison/Parsers.hs @@ -81,5 +81,5 @@ unsafeParseFileBuiltinsOnly = names = Builtin.names } -unsafeParseFile :: Monad m => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) +unsafeParseFile :: (Monad m) => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) unsafeParseFile s pEnv = unsafeGetRightFrom s <$> parseFile "" s pEnv diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs index 06088b8618..10e7ed42a1 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs @@ -39,20 +39,20 @@ data Constraint vt v loc NegLit v PmLit | -- | Positive constraint on list element with position relative to head of list PosListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable | -- | Positive constraint on list element with position relative to end of list PosListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable | -- | Negative constraint on length of the list (/i.e./ the list -- may not be an element of the interval set) NegListInterval v IntervalSet diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs index 38feb90cc5..7a353817a6 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs @@ -43,21 +43,21 @@ data Literal vt v loc NegLit v PmLit | -- | Positive constraint on list element with position relative to head of list PosListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable (Type vt loc) | -- | Positive constraint on list element with position relative to end of list PosListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable (Type vt loc) | -- | Negative constraint on length of the list (/i.e./ the list -- may not be an element of the interval set) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs index 4cb60551bd..832a8bb5fe 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs @@ -216,14 +216,14 @@ data VarConstraints vt v loc | Vc'Text (Maybe Text) (Set Text) | Vc'Char (Maybe Char) (Set Char) | Vc'ListRoot + -- | type of list elems (Type vt loc) - -- ^ type of list elems + -- | Positive constraint on cons elements (Seq v) - -- ^ Positive constraint on cons elements + -- | Positive constraint on snoc elements (Seq v) - -- ^ Positive constraint on snoc elements + -- | positive constraint on input list size IntervalSet - -- ^ positive constraint on input list size deriving stock (Show, Eq, Ord, Generic) data EffectInfo diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs index 9a7721cf58..41bf27573a 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs @@ -17,39 +17,39 @@ data loc -- annotation = -- | @PmCon x Con xs ys@ corresponds to the constraint @Con ys <- x@ PmCon + -- | Variable v - -- ^ Variable + -- | Constructor ConstructorReference - -- ^ Constructor + -- | Constructor argument values and types [(v, Type vt loc)] - -- ^ Constructor argument values and types | PmEffect + -- | Variable v - -- ^ Variable + -- | Constructor ConstructorReference - -- ^ Constructor + -- | Constructor argument values and types [(v, Type vt loc)] - -- ^ Constructor argument values and types | PmEffectPure v (v, Type vt loc) | PmLit v PmLit | PmListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable + -- | element type (Type vt loc) - -- ^ element type | PmListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable + -- | element type (Type vt loc) - -- ^ element type | -- | The size of the list must fall within this inclusive range PmListInterval v Int Int | -- | If a guard performs an effect diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs index 5c10aa36ee..b605750686 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs @@ -518,12 +518,9 @@ addConstraint con0 nc = do C.PosLit var pmlit -> let updateLiteral pos neg lit | Just lit1 <- pos, - lit1 == lit = case lit1 == lit of + lit1 == lit = -- we already have this positive constraint - True -> (pure (), Ignore) - -- contradicts positive info - False -> (contradiction, Ignore) - -- the constraint contradicts negative info + (pure (), Ignore) | Set.member lit neg = (contradiction, Ignore) | otherwise = (pure (), Update (Just lit, neg)) in modifyLiteralC var pmlit updateLiteral nc diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv.hs b/parser-typechecker/src/Unison/PrettyPrintEnv.hs index 07fa935074..005bce8472 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv.hs @@ -28,7 +28,7 @@ import Unison.ConstructorReference (ConstructorReference) import Unison.ConstructorType qualified as CT import Unison.HashQualified (HashQualified) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs index 4d511091eb..5d8264202c 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs @@ -18,7 +18,7 @@ module Unison.PrettyPrintEnv.Names where import Data.Set qualified as Set -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index d95ffed4a1..5647ccde63 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -33,7 +33,7 @@ import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef, pattern TupleType') import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.HashQualified (HashQualified) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Kind (Kind) import Unison.Kind qualified as Kind import Unison.KindInference.Error.Pretty (prettyKindError) @@ -75,6 +75,7 @@ import Unison.Util.Monoid (intercalateMap) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pr import Unison.Util.Range (Range (..), startingLine) +import Unison.Util.Text (ordinal) import Unison.Var (Var) import Unison.Var qualified as Var @@ -126,6 +127,10 @@ styleAnnotated sty a = (,sty) <$> rangeForAnnotated a style :: s -> String -> Pretty (AnnotatedText s) style sty str = Pr.lit . AT.annotate sty $ fromString str +-- | Applies the color highlighting for `Code`, but also quotes the code, to separate it from the containing context. +quoteCode :: String -> Pretty ColorText +quoteCode = Pr.backticked . style Code + stylePretty :: Color -> Pretty ColorText -> Pretty ColorText stylePretty = Pr.map . AT.annotate @@ -827,14 +832,6 @@ renderTypeError e env src = case e of let sz = length wrongs pl a b = if sz == 1 then a else b in mconcat [txt pl, intercalateMap "\n" (renderSuggestion env) wrongs] - ordinal :: (IsString s) => Int -> s - ordinal n = - fromString $ - show n ++ case last (show n) of - '1' -> "st" - '2' -> "nd" - '3' -> "rd" - _ -> "th" debugNoteLoc a = if Settings.debugNoteLoc then a else mempty debugSummary :: C.ErrorNote v loc -> Pretty ColorText debugSummary note = @@ -1366,31 +1363,31 @@ renderParseErrors s = \case <> style ErrorSite (fromString open) <> ".\n\n" <> excerpt - L.InvalidWordyId _id -> + L.ReservedWordyId id -> Pr.lines - [ "This identifier isn't valid syntax: ", + [ "The identifier " <> quoteCode id <> " used here is a reserved keyword: ", "", excerpt, - "Here's a few examples of valid syntax: " - <> style Code "abba1', snake_case, Foo.zoink!, 🌻" - ] - L.ReservedWordyId _id -> - Pr.lines - [ "The identifier used here isn't allowed to be a reserved keyword: ", - "", - excerpt + Pr.wrap $ + "You can avoid this problem either by renaming the identifier or wrapping it in backticks (like " + <> style Code ("`" <> id <> "`") + <> ")." ] - L.InvalidSymbolyId _id -> + L.InvalidSymbolyId id -> Pr.lines - [ "This infix identifier isn't valid syntax: ", + [ "The infix identifier " <> quoteCode id <> " isn’t valid syntax: ", "", excerpt, - "Here's a few valid examples: " - <> style Code "++, Float./, `List.map`" + "Here are a few valid examples: " + <> quoteCode "++" + <> ", " + <> quoteCode "Float./" + <> ", and " + <> quoteCode "List.map" ] - L.ReservedSymbolyId _id -> + L.ReservedSymbolyId id -> Pr.lines - [ "This identifier is reserved by Unison and can't be used as an operator: ", + [ "The identifier " <> quoteCode id <> " is reserved by Unison and can't be used as an operator: ", "", excerpt ] @@ -1444,11 +1441,12 @@ renderParseErrors s = \case "", excerpt, Pr.wrap $ - "I was expecting some digits after the '.'," - <> "for example: " - <> style Code (n <> "0") + "I was expecting some digits after the " + <> quoteCode "." + <> ", for example: " + <> quoteCode (n <> "0") <> "or" - <> Pr.group (style Code (n <> "1e37") <> ".") + <> Pr.group (quoteCode (n <> "1e37") <> ".") ] L.MissingExponent n -> Pr.lines @@ -1458,7 +1456,7 @@ renderParseErrors s = \case Pr.wrap $ "I was expecting some digits for the exponent," <> "for example: " - <> Pr.group (style Code (n <> "37") <> ".") + <> Pr.group (quoteCode (n <> "37") <> ".") ] L.TextLiteralMissingClosingQuote _txt -> Pr.lines @@ -1474,7 +1472,7 @@ renderParseErrors s = \case "", "I only know about the following escape characters:", "", - let s ch = style Code (fromString $ "\\" <> [ch]) + let s ch = quoteCode (fromString $ "\\" <> [ch]) in Pr.indentN 2 $ intercalateMap "," s (fst <$> L.escapeChars) ] L.LayoutError -> @@ -1705,7 +1703,7 @@ renderParseErrors s = \case let msg = mconcat [ "This looks like the start of an expression here but I was expecting a binding.", - "\nDid you mean to use a single " <> style Code ":", + "\nDid you mean to use a single " <> quoteCode ":", " here for a type signature?", "\n\n", tokenAsErrorSite s t diff --git a/parser-typechecker/src/Unison/Project/Util.hs b/parser-typechecker/src/Unison/Project/Util.hs deleted file mode 100644 index 2848a07564..0000000000 --- a/parser-typechecker/src/Unison/Project/Util.hs +++ /dev/null @@ -1,158 +0,0 @@ -module Unison.Project.Util - ( projectPath, - projectBranchesPath, - projectBranchPath, - projectBranchSegment, - projectPathPrism, - projectBranchPathPrism, - projectContextFromPath, - pattern UUIDNameSegment, - ProjectContext (..), - pattern ProjectsNameSegment, - pattern BranchesNameSegment, - ) -where - -import Control.Lens -import Data.Text qualified as Text -import Data.UUID (UUID) -import Data.UUID qualified as UUID -import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..)) -import Unison.Codebase.Path qualified as Path -import Unison.NameSegment.Internal (NameSegment (NameSegment)) -import Unison.NameSegment.Internal qualified as NameSegment -import Unison.Project (ProjectAndBranch (..)) - --- | Get the path that a project is stored at. Users aren't supposed to go here. --- --- >>> projectPath "ABCD" --- .__projects._ABCD -projectPath :: ProjectId -> Path.Absolute -projectPath projectId = - review projectPathPrism projectId - --- | Get the path that a project's branches are stored at. Users aren't supposed to go here. --- --- >>> projectBranchesPath "ABCD" --- .__projects._ABCD.branches -projectBranchesPath :: ProjectId -> Path.Absolute -projectBranchesPath projectId = - snoc (projectPath projectId) BranchesNameSegment - --- | Get the path that a branch is stored at. Users aren't supposed to go here. --- --- >>> projectBranchPath ProjectAndBranch { project = "ABCD", branch = "DEFG" } --- .__projects._ABCD.branches._DEFG -projectBranchPath :: ProjectAndBranch ProjectId ProjectBranchId -> Path.Absolute -projectBranchPath projectAndBranch = - review projectBranchPathPrism (projectAndBranch, Path.empty) - --- | Get the name segment that a branch is stored at. --- --- >>> projectBranchSegment "DEFG" --- "_DEFG" -projectBranchSegment :: ProjectBranchId -> NameSegment -projectBranchSegment (ProjectBranchId branchId) = - UUIDNameSegment branchId - -pattern UUIDNameSegment :: UUID -> NameSegment -pattern UUIDNameSegment uuid <- - ( NameSegment.toUnescapedText -> - (Text.uncons -> Just ('_', UUID.fromText . Text.map (\c -> if c == '_' then '-' else c) -> Just uuid)) - ) - where - UUIDNameSegment uuid = - NameSegment (Text.cons '_' (Text.map (\c -> if c == '-' then '_' else c) (UUID.toText uuid))) - --- | The prism between paths like --- --- @ --- .__projects._XX_XX --- @ --- --- and the project id --- --- @ --- XX-XX --- @ -projectPathPrism :: Prism' Path.Absolute ProjectId -projectPathPrism = - prism' toPath toId - where - toPath :: ProjectId -> Path.Absolute - toPath projectId = - Path.Absolute (Path.fromList [ProjectsNameSegment, UUIDNameSegment (unProjectId projectId)]) - - toId :: Path.Absolute -> Maybe ProjectId - toId path = - case Path.toList (Path.unabsolute path) of - [ProjectsNameSegment, UUIDNameSegment projectId] -> Just (ProjectId projectId) - _ -> Nothing - --- | The prism between paths like --- --- @ --- .__projects._XX_XX.branches._YY_YY.foo.bar --- @ --- --- and the @(project id, branch id, path)@ triple --- --- @ --- (XX-XX, YY-YY, foo.bar) --- @ -projectBranchPathPrism :: Prism' Path.Absolute (ProjectAndBranch ProjectId ProjectBranchId, Path.Path) -projectBranchPathPrism = - prism' toPath toIds - where - toPath :: (ProjectAndBranch ProjectId ProjectBranchId, Path.Path) -> Path.Absolute - toPath (ProjectAndBranch {project = projectId, branch = branchId}, restPath) = - Path.Absolute $ - Path.fromList - ( [ ProjectsNameSegment, - UUIDNameSegment (unProjectId projectId), - BranchesNameSegment, - UUIDNameSegment (unProjectBranchId branchId) - ] - ++ Path.toList restPath - ) - - toIds :: Path.Absolute -> Maybe (ProjectAndBranch ProjectId ProjectBranchId, Path.Path) - toIds path = - case Path.toList (Path.unabsolute path) of - ProjectsNameSegment : UUIDNameSegment projectId : BranchesNameSegment : UUIDNameSegment branchId : restPath -> - Just (ProjectAndBranch {project = ProjectId projectId, branch = ProjectBranchId branchId}, Path.fromList restPath) - _ -> Nothing - --- | The project information about the current path. --- NOTE: if the user has cd'd into the project storage area but NOT into a branch, (where they shouldn't ever --- be), this will result in a LooseCodePath. -data ProjectContext - = LooseCodePath Path.Absolute - | ProjectBranchPath ProjectId ProjectBranchId Path.Path {- path from branch root -} - deriving stock (Eq, Show) - -projectContextFromPath :: Path.Absolute -> ProjectContext -projectContextFromPath path = - case path ^? projectBranchPathPrism of - Just (ProjectAndBranch {project = projectId, branch = branchId}, restPath) -> - ProjectBranchPath projectId branchId restPath - Nothing -> - LooseCodePath path - -pattern ProjectsNameSegment :: NameSegment -pattern ProjectsNameSegment <- - ((== projectsNameSegment) -> True) - where - ProjectsNameSegment = projectsNameSegment - -pattern BranchesNameSegment :: NameSegment -pattern BranchesNameSegment <- - ((== branchesNameSegment) -> True) - where - BranchesNameSegment = branchesNameSegment - -projectsNameSegment :: NameSegment -projectsNameSegment = NameSegment "__projects" - -branchesNameSegment :: NameSegment -branchesNameSegment = NameSegment "branches" diff --git a/parser-typechecker/src/Unison/Result.hs b/parser-typechecker/src/Unison/Result.hs index 2c1a75662e..63df0a99e0 100644 --- a/parser-typechecker/src/Unison/Result.hs +++ b/parser-typechecker/src/Unison/Result.hs @@ -39,7 +39,7 @@ pattern Result notes may = MaybeT (WriterT (Identity (may, notes))) {-# COMPLETE Result #-} -makeResult :: Applicative m => notes -> Maybe a -> ResultT notes m a +makeResult :: (Applicative m) => notes -> Maybe a -> ResultT notes m a makeResult notes value = MaybeT (WriterT (pure (value, notes))) diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs index 9b77728f60..0c2fa20ff8 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF.hs @@ -169,7 +169,7 @@ expandSimple keep (v, bnd) = (v, apps' (var a v) evs) evs = map (var a) . Set.toList $ Set.difference fvs keep abstract :: (Var v) => Set v -> Term v a -> Term v a -abstract keep bnd = lam' a evs bnd +abstract keep bnd = lamWithoutBindingAnns a evs bnd where a = ABT.annotation bnd fvs = ABT.freeVars bnd @@ -205,7 +205,7 @@ enclose keep rec (Let1NamedTop' top v b@(unAnn -> LamsNamed' vs bd) e) = annotate tm | Ann' _ ty <- b = ann a tm ty | otherwise = tm - lamb = lam' a evs (annotate $ lam' a vs lbody) + lamb = lamWithoutBindingAnns a evs (annotate $ lamWithoutBindingAnns a vs lbody) enclose keep rec t@(unLamsAnnot -> Just (vs0, mty, vs1, body)) = Just $ if null evs then lamb else apps' lamb $ map (var a) evs where @@ -218,7 +218,7 @@ enclose keep rec t@(unLamsAnnot -> Just (vs0, mty, vs1, body)) = annotate tm | Just ty <- mty = ann a tm ty | otherwise = tm - lamb = lam' a (evs ++ vs0) . annotate . lam' a vs1 $ lbody + lamb = lamWithoutBindingAnns a (evs ++ vs0) . annotate . lamWithoutBindingAnns a vs1 $ lbody enclose keep rec t@(Handle' h body) | isStructured body = Just . handle (ABT.annotation t) (rec keep h) $ apps' lamb args @@ -232,8 +232,8 @@ enclose keep rec t@(Handle' h body) | null evs = [constructor a (ConstructorReference Ty.unitRef 0)] | otherwise = var a <$> evs lamb - | null evs = lam' a [fv] lbody - | otherwise = lam' a evs lbody + | null evs = lamWithoutBindingAnns a [fv] lbody + | otherwise = lamWithoutBindingAnns a evs lbody enclose keep rec t@(Match' s0 cs0) = Just $ match a s cs where a = ABT.annotation t @@ -331,7 +331,7 @@ beta rec (LetRecNamedTop' top (fmap (fmap rec) -> vbs) (rec -> bd)) = vbs <&> \(v, b0) -> (v,ABT.annotation b0,) $ case b0 of LamsNamed' vs b | Just n <- Map.lookup v m -> - lam' (ABT.annotation b0) (drop n vs) (dropPrefixes m b) + lamWithoutBindingAnns (ABT.annotation b0) (drop n vs) (dropPrefixes m b) -- shouldn't happen b -> dropPrefixes m b @@ -340,7 +340,7 @@ beta rec (Let1NamedTop' top v l@(LamsNamed' vs bd) (rec -> e)) | n > 0 = Just $ let1' top [(v, lamb)] (dropPrefix v n e) | otherwise = Nothing where - lamb = lam' al (drop n vs) (bd) + lamb = lamWithoutBindingAnns al (drop n vs) (bd) al = ABT.annotation l -- Calculate a maximum number of arguments to drop. -- Enclosing doesn't create let-bound lambdas, so we @@ -353,7 +353,7 @@ beta rec (Let1NamedTop' top v l@(LamsNamed' vs bd) (rec -> e)) beta rec (Apps' l@(LamsNamed' vs body) as) | n <- matchVars 0 vs as, n > 0 = - Just $ apps' (lam' al (drop n vs) (rec body)) (drop n as) + Just $ apps' (lamWithoutBindingAnns al (drop n vs) (rec body)) (drop n as) | otherwise = Nothing where al = ABT.annotation l @@ -422,7 +422,7 @@ groupFloater rec vbs = do where rec' b | Just (vs0, mty, vs1, bd) <- unLamsAnnot b = - lam' a vs0 . maybe id (flip $ ann a) mty . lam' a vs1 <$> rec bd + lamWithoutBindingAnns a vs0 . maybe id (flip $ ann a) mty . lamWithoutBindingAnns a vs1 <$> rec bd where a = ABT.annotation b rec' b = rec b @@ -453,12 +453,12 @@ lamFloater closed tm mv a vs bd = let v = ABT.freshIn cvs $ fromMaybe (typed Var.Float) mv in ( v, ( Set.insert v cvs, - ctx <> [(v, lam' a vs bd)], + ctx <> [(v, lamWithoutBindingAnns a vs bd)], floatDecomp closed v tm dcmp ) ) where - tgt = unannotate (lam' a vs bd) + tgt = unannotate (lamWithoutBindingAnns a vs bd) p (_, flam) = unannotate flam == tgt floatDecomp :: @@ -479,7 +479,7 @@ floater top rec tm0@(Ann' tm ty) = floater top rec (LetRecNamed' vbs e) = Just $ letFloater rec vbs e >>= \case - lm@(LamsNamed' vs bd) | top -> lam' a vs <$> rec bd + lm@(LamsNamed' vs bd) | top -> lamWithoutBindingAnns a vs <$> rec bd where a = ABT.annotation lm tm -> rec tm @@ -492,7 +492,7 @@ floater _ rec (Let1Named' v b e) where a = ABT.annotation b floater top rec tm@(LamsNamed' vs bd) - | top = Just $ lam' a vs <$> rec bd + | top = Just $ lamWithoutBindingAnns a vs <$> rec bd | otherwise = Just $ do bd <- rec bd lv <- lamFloater True tm Nothing a vs bd @@ -627,7 +627,7 @@ saturate dat = ABT.visitPure $ \case | m < n, vs <- snd $ mapAccumL frsh fvs [1 .. n - m], nargs <- var mempty <$> vs -> - Just . lam' mempty vs . apps' f $ args' ++ nargs + Just . lamWithoutBindingAnns mempty vs . apps' f $ args' ++ nargs | m > n, (sargs, eargs) <- splitAt n args', sv <- Var.freshIn fvs $ typed Var.Eta -> @@ -1909,15 +1909,16 @@ anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) [] <- vs = AccumText Nothing . Map.singleton (Util.Text.fromText t) <$> anfBody bd | P.Constructor _ (ConstructorReference r t) ps <- p = do - (,) <$> expandBindings ps vs <*> anfBody bd <&> \(us, bd) -> - AccumData r Nothing - . EC.mapSingleton (fromIntegral t) - . (BX <$ us,) - . ABTN.TAbss us - $ bd + (,) + <$> expandBindings ps vs + <*> anfBody bd + <&> \(us, bd) -> + AccumData r Nothing . EC.mapSingleton (fromIntegral t) . (BX <$ us,) $ ABTN.TAbss us bd | P.EffectPure _ q <- p = - (,) <$> expandBindings [q] vs <*> anfBody bd <&> \(us, bd) -> - AccumPure $ ABTN.TAbss us bd + (,) + <$> expandBindings [q] vs + <*> anfBody bd + <&> \(us, bd) -> AccumPure $ ABTN.TAbss us bd | P.EffectBind _ (ConstructorReference r t) ps pk <- p = do (,,) <$> expandBindings (snoc ps pk) vs @@ -1934,8 +1935,7 @@ anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) . (BX <$ us,) . ABTN.TAbss us . TShift r kf - . TName uk (Left jn) [kf] - $ bd + $ TName uk (Left jn) [kf] bd | P.SequenceLiteral _ [] <- p = AccumSeqEmpty <$> anfBody bd | P.SequenceOp _ l op r <- p, @@ -1985,7 +1985,7 @@ blitLinks :: (Monoid a) => (Bool -> Reference -> a) -> BLit -> a blitLinks f (List s) = foldMap (valueLinks f) s blitLinks _ _ = mempty -groupTermLinks :: Var v => SuperGroup v -> [Reference] +groupTermLinks :: (Var v) => SuperGroup v -> [Reference] groupTermLinks = Set.toList . foldGroupLinks f where f False r = Set.singleton r diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs b/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs index 3a501744ff..4bd3c2434f 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs @@ -19,7 +19,7 @@ import Unison.Runtime.ANF.Serialize as ANF import Unison.Var (Var) checkGroupHashes :: - Var v => + (Var v) => [(Referent, SuperGroup v)] -> Either (Text, [Referent]) (Either [Referent] [Referent]) checkGroupHashes rgs = case checkMissing rgs of @@ -32,7 +32,7 @@ checkGroupHashes rgs = case checkMissing rgs of Right ms -> Right (Left $ Ref <$> ms) rehashGroups :: - Var v => + (Var v) => Map.Map Reference (SuperGroup v) -> Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) rehashGroups m @@ -56,7 +56,7 @@ rehashGroups m (rm, sgs) = rehashSCC scc checkMissing :: - Var v => + (Var v) => [(Referent, SuperGroup v)] -> Either (Text, [Referent]) [Reference] checkMissing (unzip -> (rs, gs)) = do @@ -74,7 +74,7 @@ checkMissing (unzip -> (rs, gs)) = do p _ _ = False rehashSCC :: - Var v => + (Var v) => SCC (Reference, SuperGroup v) -> (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) rehashSCC scc diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs index b4e04d40cc..995856e1b4 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs @@ -19,11 +19,11 @@ import Data.Sequence qualified as Seq import Data.Serialize.Put (runPutLazy) import Data.Text (Text) import Data.Word (Word16, Word32, Word64) +import GHC.IsList qualified (fromList) import GHC.Stack import Unison.ABT.Normalized (Term (..)) import Unison.Reference (Reference, Reference' (Builtin), pattern Derived) import Unison.Runtime.ANF as ANF hiding (Tag) -import Unison.Runtime.Array qualified as PA import Unison.Runtime.Exception import Unison.Runtime.Serialize import Unison.Util.EnumContainers qualified as EC @@ -682,7 +682,7 @@ getBLit v = NegT -> Neg <$> getPositive CharT -> Char <$> getChar FloatT -> Float <$> getFloat - ArrT -> Arr . PA.fromList <$> getList (getValue v) + ArrT -> Arr . GHC.IsList.fromList <$> getList (getValue v) putRefs :: (MonadPut m) => [Reference] -> m () putRefs rs = putFoldable putReference rs @@ -948,7 +948,7 @@ serializeGroup fops sg = runPutS (putVersion *> putGroup mempty fops sg) -- Supplying a `Builtin` reference is not supported. Such code -- shouldn't be subject to rehashing. serializeGroupForRehash :: - Var v => + (Var v) => EC.EnumMap FOp Text -> Reference -> SuperGroup v -> @@ -962,7 +962,7 @@ serializeGroupForRehash fops (Derived h _) sg = f _ = Nothing refrep = Map.fromList . mapMaybe f $ groupTermLinks sg -getVersionedValue :: MonadGet m => m Value +getVersionedValue :: (MonadGet m) => m Value getVersionedValue = getVersion >>= getValue where getVersion = diff --git a/parser-typechecker/src/Unison/Runtime/Array.hs b/parser-typechecker/src/Unison/Runtime/Array.hs index 2faa68903a..1b6d34fdc2 100644 --- a/parser-typechecker/src/Unison/Runtime/Array.hs +++ b/parser-typechecker/src/Unison/Runtime/Array.hs @@ -56,7 +56,7 @@ import Data.Primitive.PrimArray as EPA hiding import Data.Primitive.PrimArray qualified as PA import Data.Primitive.Types import Data.Word (Word8) -import GHC.Exts (toList) +import GHC.IsList (toList) #ifdef ARRAY_CHECK import GHC.Stack diff --git a/parser-typechecker/src/Unison/Runtime/Decompile.hs b/parser-typechecker/src/Unison/Runtime/Decompile.hs index a1b1646ce8..00e8c4445a 100644 --- a/parser-typechecker/src/Unison/Runtime/Decompile.hs +++ b/parser-typechecker/src/Unison/Runtime/Decompile.hs @@ -230,7 +230,11 @@ decompileForeign backref topTerms f | Just s <- unwrapSeq f = list' () <$> traverse (decompile backref topTerms) s decompileForeign _ _ (Wrap r _) = - err (BadForeign r) $ bug "" + err (BadForeign r) $ bug text + where + text + | Builtin name <- r = "<" <> name <> ">" + | otherwise = "" decompileBytes :: (Var v) => By.Bytes -> Term v () decompileBytes = diff --git a/parser-typechecker/src/Unison/Runtime/Exception.hs b/parser-typechecker/src/Unison/Runtime/Exception.hs index dff4a627b7..16a149d953 100644 --- a/parser-typechecker/src/Unison/Runtime/Exception.hs +++ b/parser-typechecker/src/Unison/Runtime/Exception.hs @@ -18,7 +18,7 @@ instance Exception RuntimeExn die :: (HasCallStack) => String -> IO a die = throwIO . PE callStack . P.lit . fromString -dieP :: HasCallStack => P.Pretty P.ColorText -> IO a +dieP :: (HasCallStack) => P.Pretty P.ColorText -> IO a dieP = throwIO . PE callStack exn :: (HasCallStack) => String -> a diff --git a/parser-typechecker/src/Unison/Runtime/Interface.hs b/parser-typechecker/src/Unison/Runtime/Interface.hs index 3b74b59e88..66139742bb 100644 --- a/parser-typechecker/src/Unison/Runtime/Interface.hs +++ b/parser-typechecker/src/Unison/Runtime/Interface.hs @@ -23,8 +23,10 @@ where import Control.Concurrent.STM as STM import Control.Exception (throwIO) import Control.Monad -import Data.Binary.Get (runGetOrFail) -- import Data.Bits (shiftL) + +import Control.Monad.State +import Data.Binary.Get (runGetOrFail) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Bytes.Get (MonadGet, getWord8, runGetS) @@ -133,6 +135,7 @@ import Unison.Syntax.NamePrinter (prettyHashQualified) import Unison.Syntax.TermPrinter import Unison.Term qualified as Tm import Unison.Util.EnumContainers as EC +import Unison.Util.Monoid (foldMapM) import Unison.Util.Pretty as P import UnliftIO qualified import UnliftIO.Concurrent qualified as UnliftIO @@ -195,23 +198,26 @@ allocType ctx r cons = pure $ ctx {dspec = Map.insert r cons $ dspec ctx} recursiveDeclDeps :: - Set RF.LabeledDependency -> CodeLookup Symbol IO () -> Decl Symbol () -> -- (type deps, term deps) - IO (Set Reference, Set Reference) -recursiveDeclDeps seen0 cl d = do - rec <- for (toList newDeps) $ \case - RF.DerivedId i -> - getTypeDeclaration cl i >>= \case - Just d -> recursiveDeclDeps seen cl d - Nothing -> pure mempty - _ -> pure mempty - pure $ (deps, mempty) <> fold rec + StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) +recursiveDeclDeps cl d = do + seen0 <- get + let seen = seen0 <> Set.map RF.typeRef deps + put seen + let newDeps = Set.filter (\r -> notMember (RF.typeRef r) seen0) deps + rec <- + (toList newDeps) & foldMapM \r -> do + case r of + RF.DerivedId i -> + lift (getTypeDeclaration cl i) >>= \case + Just d -> recursiveDeclDeps cl d + Nothing -> pure mempty + _ -> pure mempty + pure $ (deps, mempty) <> rec where deps = declTypeDependencies d - newDeps = Set.filter (\r -> notMember (RF.typeRef r) seen0) deps - seen = seen0 <> Set.map RF.typeRef deps categorize :: RF.LabeledDependency -> (Set Reference, Set Reference) categorize = @@ -221,37 +227,39 @@ categorize = RF.TermReference ref -> (mempty, Set.singleton ref) recursiveTermDeps :: - Set RF.LabeledDependency -> CodeLookup Symbol IO () -> Term Symbol -> -- (type deps, term deps) - IO (Set Reference, Set Reference) -recursiveTermDeps seen0 cl tm = do - rec <- for (toList (deps \\ seen0)) $ \case - RF.ConReference (RF.ConstructorReference (RF.DerivedId refId) _conId) _conType -> handleTypeReferenceId refId - RF.TypeReference (RF.DerivedId refId) -> handleTypeReferenceId refId - RF.TermReference r -> recursiveRefDeps seen cl r - _ -> pure mempty - pure $ foldMap categorize deps <> fold rec + StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) +recursiveTermDeps cl tm = do + seen0 <- get + let seen = seen0 <> deps + put seen + rec <- + (toList (deps \\ seen0)) & foldMapM \r -> + case r of + RF.ConReference (RF.ConstructorReference (RF.DerivedId refId) _conId) _conType -> handleTypeReferenceId refId + RF.TypeReference (RF.DerivedId refId) -> handleTypeReferenceId refId + RF.TermReference r -> recursiveRefDeps cl r + _ -> pure mempty + pure $ foldMap categorize deps <> rec where - handleTypeReferenceId :: RF.Id -> IO (Set Reference, Set Reference) + handleTypeReferenceId :: RF.Id -> StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) handleTypeReferenceId refId = - getTypeDeclaration cl refId >>= \case - Just d -> recursiveDeclDeps seen cl d + lift (getTypeDeclaration cl refId) >>= \case + Just d -> recursiveDeclDeps cl d Nothing -> pure mempty deps = Tm.labeledDependencies tm - seen = seen0 <> deps recursiveRefDeps :: - Set RF.LabeledDependency -> CodeLookup Symbol IO () -> Reference -> - IO (Set Reference, Set Reference) -recursiveRefDeps seen cl (RF.DerivedId i) = - getTerm cl i >>= \case - Just tm -> recursiveTermDeps seen cl tm + StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) +recursiveRefDeps cl (RF.DerivedId i) = + lift (getTerm cl i) >>= \case + Just tm -> recursiveTermDeps cl tm Nothing -> pure mempty -recursiveRefDeps _ _ _ = pure mempty +recursiveRefDeps _ _ = pure mempty recursiveIRefDeps :: Map.Map Reference (SuperGroup Symbol) -> @@ -289,8 +297,8 @@ collectDeps :: Term Symbol -> IO ([(Reference, Either [Int] [Int])], [Reference]) collectDeps cl tm = do - (tys, tms) <- recursiveTermDeps mempty cl tm - (,toList tms) <$> traverse getDecl (toList tys) + (tys, tms) <- evalStateT (recursiveTermDeps cl tm) mempty + (,toList tms) <$> (traverse getDecl (toList tys)) where getDecl ty@(RF.DerivedId i) = (ty,) . maybe (Right []) declFields @@ -497,7 +505,7 @@ interpEval activeThreads cleanupThreads ctxVar cl ppe tm = evalInContext ppe ctx activeThreads initw `UnliftIO.finally` cleanupThreads -ensureExists :: HasCallStack => CreateProcess -> (CmdSpec -> Either (Int, String, String) IOException -> Pretty ColorText) -> IO () +ensureExists :: (HasCallStack) => CreateProcess -> (CmdSpec -> Either (Int, String, String) IOException -> Pretty ColorText) -> IO () ensureExists cmd err = ccall >>= \case Nothing -> pure () @@ -509,13 +517,13 @@ ensureExists cmd err = (ExitFailure exitCode, stdout, stderr) -> pure (Just (Left (exitCode, stdout, stderr))) ccall = call `UnliftIO.catch` \(e :: IOException) -> pure . Just $ Right e -ensureRuntimeExists :: HasCallStack => FilePath -> IO () +ensureRuntimeExists :: (HasCallStack) => FilePath -> IO () ensureRuntimeExists executable = ensureExists cmd runtimeErrMsg where cmd = proc executable ["--help"] -ensureRacoExists :: HasCallStack => IO () +ensureRacoExists :: (HasCallStack) => IO () ensureRacoExists = ensureExists (shell "raco help") racoErrMsg prettyCmdSpec :: CmdSpec -> Pretty ColorText diff --git a/parser-typechecker/src/Unison/Runtime/MCode.hs b/parser-typechecker/src/Unison/Runtime/MCode.hs index 28f821f231..c3d9c837bb 100644 --- a/parser-typechecker/src/Unison/Runtime/MCode.hs +++ b/parser-typechecker/src/Unison/Runtime/MCode.hs @@ -36,7 +36,6 @@ module Unison.Runtime.MCode ) where -import Control.Applicative (liftA2) import Data.Bifunctor (bimap, first) import Data.Bits (shiftL, shiftR, (.|.)) import Data.Coerce diff --git a/parser-typechecker/src/Unison/Runtime/Machine.hs b/parser-typechecker/src/Unison/Runtime/Machine.hs index 473fdb34a0..eecc5cc09b 100644 --- a/parser-typechecker/src/Unison/Runtime/Machine.hs +++ b/parser-typechecker/src/Unison/Runtime/Machine.hs @@ -384,7 +384,7 @@ exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 DBTX i) ustk <- bump ustk bstk <- case tracer env False clo of NoTrace -> bstk <$ poke ustk 0 - MsgTrace _ tx _ -> do + MsgTrace _ _ tx -> do poke ustk 1 bstk <- bump bstk bstk <$ pokeBi bstk (Util.Text.pack tx) diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs index 622fc11e79..064200cd55 100644 --- a/parser-typechecker/src/Unison/Runtime/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs @@ -2,7 +2,6 @@ module Unison.Runtime.Serialize where -import Control.Applicative (liftA2) import Control.Monad (replicateM) import Data.Bits (Bits) import Data.ByteString qualified as B @@ -118,11 +117,7 @@ getLength = unVarInt <$> deserialize -- Checks for negatives, in case you put an Integer, which does not -- behave properly for negative numbers. putPositive :: - MonadPut m => - Bits n => - Bits (Unsigned n) => - Integral n => - Integral (Unsigned n) => + (MonadPut m, Bits n, Bits (Unsigned n), Integral n, Integral (Unsigned n)) => n -> m () putPositive n @@ -131,12 +126,7 @@ putPositive n -- Reads as an Integer, then checks that the result will fit in the -- result type. -getPositive :: - forall m n. - Bounded n => - Integral n => - MonadGet m => - m n +getPositive :: forall m n. (Bounded n, Integral n, MonadGet m) => m n getPositive = validate . unVarInt =<< deserialize where mx0 :: n diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 9d2c7f23f3..6185747380 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -125,7 +125,7 @@ file = do -- | Final validations and sanity checks to perform before finishing parsing. validateUnisonFile :: - Ord v => + (Ord v) => Map v (TypeReferenceId, DataDeclaration v Ann) -> Map v (TypeReferenceId, EffectDeclaration v Ann) -> [(v, Ann, Term v Ann)] -> @@ -139,7 +139,7 @@ validateUnisonFile datas effects terms watches = -- constructors and verify that no duplicates exist in the file, triggering an error if needed. checkForDuplicateTermsAndConstructors :: forall m v. - Ord v => + (Ord v) => Map v (TypeReferenceId, DataDeclaration v Ann) -> Map v (TypeReferenceId, EffectDeclaration v Ann) -> [(v, Ann, Term v Ann)] -> diff --git a/parser-typechecker/src/Unison/Syntax/NamePrinter.hs b/parser-typechecker/src/Unison/Syntax/NamePrinter.hs index ab51847469..8c3a70708d 100644 --- a/parser-typechecker/src/Unison/Syntax/NamePrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/NamePrinter.hs @@ -2,7 +2,7 @@ module Unison.Syntax.NamePrinter where import Data.Text qualified as Text import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 02b6442939..ff0c38cb88 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -28,7 +28,7 @@ import Unison.Builtin.Decls qualified as DD import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.ConstructorType qualified as CT import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment @@ -36,6 +36,7 @@ import Unison.Names (Names) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) +import Unison.Parser.Ann qualified as Ann import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude @@ -334,7 +335,9 @@ parsePattern = label "pattern" root lam :: (Var v) => TermP v m -> TermP v m lam p = label "lambda" $ mkLam <$> P.try (some prefixDefinitionName <* reserved "->") <*> p where - mkLam vs b = Term.lam' (ann (head vs) <> ann b) (map L.payload vs) b + mkLam vs b = + let annotatedArgs = vs <&> \v -> (ann v, L.payload v) + in Term.lam' (ann (head vs) <> ann b) annotatedArgs b letBlock, handle, ifthen :: (Monad m, Var v) => TermP v m letBlock = label "let" $ (snd <$> block "let") @@ -369,7 +372,8 @@ lamCase = do es -> DD.tupleTerm es anns = ann start <> ann (NonEmpty.last cases) matchTerm = Term.match anns lamvarTerm (toList cases) - pure $ Term.lam' anns vars matchTerm + let annotatedVars = (Ann.GeneratedFrom $ ann start,) <$> vars + pure $ Term.lam' anns annotatedVars matchTerm ifthen = label "if" do start <- peekAny @@ -398,7 +402,7 @@ hashQualifiedPrefixTerm = resolveHashQualified =<< hqPrefixId hashQualifiedInfixTerm :: (Monad m, Var v) => TermP v m hashQualifiedInfixTerm = resolveHashQualified =<< hqInfixId -quasikeyword :: Ord v => Text -> P v m (L.Token ()) +quasikeyword :: (Ord v) => Text -> P v m (L.Token ()) quasikeyword kw = queryToken \case L.WordyId (HQ'.NameOnly n) | nameIsKeyword n kw -> Just () _ -> Nothing @@ -426,7 +430,8 @@ resolveHashQualified tok = do termLeaf :: forall m v. (Monad m, Var v) => TermP v m termLeaf = asum - [ hashQualifiedPrefixTerm, + [ force, + hashQualifiedPrefixTerm, text, char, number, @@ -579,11 +584,12 @@ doc2Block = do "syntax.docExample" -> do trm <- term endTok <- closeBlock - pure . (ann startTok <> ann endTok,) $ case trm of + let spanAnn = ann startTok <> ann endTok + pure . (spanAnn,) $ case trm of tm@(Term.Apps' _ xs) -> let fvs = List.Extra.nubOrd $ concatMap (toList . Term.freeVars) xs n = Term.nat (ann tm) (fromIntegral (length fvs)) - lam = addDelay $ Term.lam' (ann tm) fvs tm + lam = addDelay $ Term.lam' (ann tm) ((Ann.GeneratedFrom spanAnn,) <$> fvs) tm in Term.apps' f [n, lam] tm -> Term.apps' f [Term.nat (ann tm) 0, addDelay tm] "syntax.docTransclude" -> evalLike id @@ -612,12 +618,13 @@ delayQuote :: (Monad m, Var v) => TermP v m delayQuote = P.label "quote" do start <- reserved "'" e <- termLeaf - pure $ DD.delayTerm (ann start <> ann e) e + pure $ DD.delayTerm (ann start <> ann e) (ann start) e delayBlock :: (Monad m, Var v) => P v m (Ann {- Ann spanning the whole block -}, Term v Ann) delayBlock = P.label "do" do (spanAnn, b) <- block "do" - pure $ (spanAnn, DD.delayTerm (ann b) b) + let argSpan = (ann b {- would be nice to use the annotation for 'do' here, but it's not terribly important -}) + pure $ (spanAnn, DD.delayTerm (ann b) argSpan b) bang :: (Monad m, Var v) => TermP v m bang = P.label "bang" do @@ -625,14 +632,22 @@ bang = P.label "bang" do e <- termLeaf pure $ DD.forceTerm (ann start <> ann e) (ann start) e +force :: forall m v. (Monad m, Var v) => TermP v m +force = P.label "force" $ P.try do + -- `forkAt pool() blah` parses as `forkAt (pool ()) blah` + -- That is, empty parens immediately (no space) following a symbol + -- is treated as high precedence function application of `Unit` + fn <- hashQualifiedPrefixTerm + tok <- ann <$> openBlockWith "(" + guard (L.column (Ann.start tok) == L.column (Ann.end (ann fn))) + close <- closeBlock + pure $ DD.forceTerm (ann fn <> ann close) (tok <> ann close) fn + seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = - Pattern.Snoc - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) - <|> Pattern.Cons - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) - <|> Pattern.Concat - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) + Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) + <|> Pattern.Cons <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) + <|> Pattern.Concat <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) term4 :: (Monad m, Var v) => TermP v m term4 = f <$> some termLeaf @@ -755,7 +770,8 @@ binding = label "binding" do mkBinding :: Ann -> [L.Token v] -> Term.Term v Ann -> Term.Term v Ann mkBinding _lhsLoc [] body = body mkBinding lhsLoc args body = - (Term.lam' (lhsLoc <> ann body) (L.payload <$> args) body) + let annotatedArgs = args <&> \arg -> (ann arg, L.payload arg) + in Term.lam' (lhsLoc <> ann body) annotatedArgs body customFailure :: (P.MonadParsec e s m) => e -> m a customFailure = P.customFailure diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index bc33c43ca2..faeda76020 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -35,7 +35,7 @@ import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorReference qualified as ConstructorReference import Unison.ConstructorType qualified as CT import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -459,7 +459,7 @@ pretty0 go tm = goNormal 10 tm PP.hang kw <$> fmap PP.lines (traverse go rs) (Bytes' bs, _) -> - pure $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) + pure $ PP.group $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) BinaryAppsPred' apps lastArg -> do prettyLast <- pretty0 (ac 3 Normal im doc) lastArg prettyApps <- binaryApps apps prettyLast @@ -490,7 +490,7 @@ pretty0 (App' x (Constructor' (ConstructorReference DD.UnitRef 0)), _) | isLeaf x -> do px <- pretty0 (ac (if isBlock x then 0 else 9) Normal im doc) x pure . paren (p >= 11 || isBlock x && p >= 3) $ - fmt S.DelayForceChar (l "!") <> PP.indentNAfterNewline 1 px + px <> fmt S.Unit (l "()") (Apps' f (unsnoc -> Just (args, lastArg)), _) | isSoftHangable lastArg -> do fun <- goNormal 9 f @@ -969,7 +969,7 @@ prettyBinding0' a@AmbientContext {imports = im, docContext = doc} v term = PP.group $ PP.group (defnLhs v vs <> fmt S.BindingEquals " = ") <> prettyBody - `PP.orElse` ("\n" <> PP.indentN 2 prettyBody) + `PP.orElse` ("\n" <> PP.indentN 2 prettyBody) } _ -> pure $ @@ -1532,7 +1532,7 @@ immediateChildBlockTerms = \case doLet (v, LamsNamedOpt' _ body) = [body | not (Var.isAction v), isLet body] doLet t = error (show t) [] -isSoftHangable :: Var v => Term2 vt at ap v a -> Bool +isSoftHangable :: (Var v) => Term2 vt at ap v a -> Bool -- isSoftHangable (Delay' d) = isLet d || isSoftHangable d || case d of -- Match' scrute cases -> isDestructuringBind scrute cases -- _ -> False @@ -1958,7 +1958,7 @@ toDocExample' suffix ppe (Apps' (Ref' r) [Nat' n, l@(LamsNamed' vs tm)]) | nameEndsWith ppe suffix r, ABT.freeVars l == mempty, ok tm = - Just (lam' (ABT.annotation l) (drop (fromIntegral n + 1) vs) tm) + Just (lamWithoutBindingAnns (ABT.annotation l) (drop (fromIntegral n + 1) vs) tm) where ok (Apps' f _) = ABT.freeVars f == mempty ok tm = ABT.freeVars tm == mempty @@ -2160,7 +2160,7 @@ avoidShadowing tm (PrettyPrintEnv terms types) = & maybe fullName HQ'.NameOnly in (fullName, minimallySuffixed) tweak _ p = p - varToName :: Var v => v -> [Name] + varToName :: (Var v) => v -> [Name] varToName = toList . Name.parseText . Var.name isLeaf :: Term2 vt at ap v a -> Bool diff --git a/parser-typechecker/src/Unison/Syntax/TypeParser.hs b/parser-typechecker/src/Unison/Syntax/TypeParser.hs index ff84f94cbe..e270ef25eb 100644 --- a/parser-typechecker/src/Unison/Syntax/TypeParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TypeParser.hs @@ -31,7 +31,7 @@ type TypeP v m = P v m (Type v Ann) -- the right of a function arrow: -- valueType ::= Int | Text | App valueType valueType | Arrow valueType computationType valueType :: (Monad m, Var v) => TypeP v m -valueType = forall type1 <|> type1 +valueType = forAll type1 <|> type1 -- Computation -- computationType ::= [{effect*}] valueType @@ -101,7 +101,7 @@ sequenceTyp = do let a = ann open <> ann close pure $ Type.app a (Type.list a) t -tupleOrParenthesizedType :: Var v => TypeP v m -> TypeP v m +tupleOrParenthesizedType :: (Var v) => TypeP v m -> TypeP v m tupleOrParenthesizedType rec = do (spanAnn, ty) <- tupleOrParenthesized rec DD.unitType pair pure (ty {ABT.annotation = ABT.annotation ty <> spanAnn}) @@ -119,8 +119,8 @@ arrow rec = in chainr1 (effect <|> rec) (reserved "->" *> eff) -- "forall a b . List a -> List b -> Maybe Text" -forall :: (Var v) => TypeP v m -> TypeP v m -forall rec = do +forAll :: (Var v) => TypeP v m -> TypeP v m +forAll rec = do kw <- reserved "forall" <|> reserved "∀" vars <- fmap (fmap L.payload) . some $ prefixDefinitionName _ <- reserved "." diff --git a/parser-typechecker/src/Unison/Typechecker.hs b/parser-typechecker/src/Unison/Typechecker.hs index d20c7bec0c..b40b5a5626 100644 --- a/parser-typechecker/src/Unison/Typechecker.hs +++ b/parser-typechecker/src/Unison/Typechecker.hs @@ -249,7 +249,7 @@ typeDirectedNameResolution ppe oldNotes oldType env = do guard x a = if x then Just a else Nothing - suggestedVar :: Var v => v -> Text -> v + suggestedVar :: (Var v) => v -> Text -> v suggestedVar v name = case Var.typeOf v of Var.MissingResult -> v diff --git a/parser-typechecker/src/Unison/Typechecker/Components.hs b/parser-typechecker/src/Unison/Typechecker/Components.hs index ccef8995d3..72dac37113 100644 --- a/parser-typechecker/src/Unison/Typechecker/Components.hs +++ b/parser-typechecker/src/Unison/Typechecker/Components.hs @@ -78,7 +78,7 @@ minimize (Term.LetRecNamedAnnotatedTop' isTop blockAnn bs e) = blockAnn [(annotatedVar hdv, hdb)] e - | otherwise = Term.singleLet isTop blockAnn (hdv, hdb) e + | otherwise = Term.singleLet isTop blockAnn (annotationFor hdv) (hdv, hdb) e mklet cycle@((_, _) : _) e = Term.letRec isTop @@ -86,10 +86,7 @@ minimize (Term.LetRecNamedAnnotatedTop' isTop blockAnn bs e) = (first annotatedVar <$> cycle) e mklet [] e = e - in -- The outer annotation is going to be meaningful, so we make - -- sure to preserve it, whereas the annotations at intermediate Abs - -- nodes aren't necessarily meaningful - Right . Just . ABT.annotate blockAnn . foldr mklet e $ cs + in Right . Just . foldr mklet e $ cs minimize _ = Right Nothing minimize' :: diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 11279cf898..89eb193212 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -606,15 +606,15 @@ debugTrace :: String -> Bool debugTrace e | debugEnabled = trace e False debugTrace _ = False -showType :: Var v => Type.Type v a -> String +showType :: (Var v) => Type.Type v a -> String showType ty = TP.prettyStr (Just 120) PPE.empty ty -debugType :: Var v => String -> Type.Type v a -> Bool +debugType :: (Var v) => String -> Type.Type v a -> Bool debugType tag ty | debugEnabled = debugTrace $ "(" <> show tag <> "," <> showType ty <> ")" | otherwise = False -debugTypes :: Var v => String -> Type.Type v a -> Type.Type v a -> Bool +debugTypes :: (Var v) => String -> Type.Type v a -> Type.Type v a -> Bool debugTypes tag t1 t2 | debugEnabled = debugTrace $ "(" <> show tag <> ",\n " <> showType t1 <> ",\n " <> showType t2 <> ")" | otherwise = False @@ -963,7 +963,7 @@ apply' solvedExistentials t = go t Type.Ann' v k -> Type.ann a (go v) k Type.Effect1' e t -> Type.effect1 a (go e) (go t) Type.Effects' es -> Type.effects a (map go es) - Type.ForallNamed' v t' -> Type.forall a v (go t') + Type.ForallNamed' v t' -> Type.forAll a v (go t') Type.IntroOuterNamed' v t' -> Type.introOuter a v (go t') _ -> error $ "Match error in Context.apply': " ++ show t where @@ -1059,7 +1059,7 @@ vectorConstructorOfArity loc arity = do let elementVar = Var.named "elem" args = replicate arity (loc, Type.var loc elementVar) resultType = Type.app loc (Type.list loc) (Type.var loc elementVar) - vt = Type.forall loc elementVar (Type.arrows args resultType) + vt = Type.forAll loc elementVar (Type.arrows args resultType) pure vt generalizeAndUnTypeVar :: (Var v) => Type v a -> Type.Type v a @@ -1984,7 +1984,7 @@ tweakEffects v0 t0 rewrite p ty | Type.ForallNamed' v t <- ty, v0 /= v = - second (Type.forall a v) <$> rewrite p t + second (Type.forAll a v) <$> rewrite p t | Type.Arrow' i o <- ty = do (vis, i) <- rewrite (not <$> p) i (vos, o) <- rewrite p o @@ -2097,7 +2097,7 @@ generalizeP p ctx0 ty = foldr gen (applyCtx ctx0 ty) ctx -- location of the forall is just the location of the input type -- and the location of each quantified variable is just inherited -- from its source location - Type.forall + Type.forAll (loc t) (TypeVar.Universal v) (ABT.substInheritAnnotation tv (universal' () v) t) @@ -2561,8 +2561,7 @@ subtype tx ty = scope (InSubtype tx ty) $ do go ctx (Type.Var' (TypeVar.Existential b v)) t -- `InstantiateL` | Set.member v (existentials ctx) && notMember v (Type.freeVars t) = do - e <- extendExistential Var.inferAbility - instantiateL b v (relax' False e t) + instantiateL b v t go ctx t (Type.Var' (TypeVar.Existential b v)) -- `InstantiateR` | Set.member v (existentials ctx) && notMember v (Type.freeVars t) = do diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index 9613ce1642..8de9b15224 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -78,7 +78,7 @@ emptyUnisonFile = watches = Map.empty } -leftBiasedMerge :: forall v a. Ord v => UnisonFile v a -> UnisonFile v a -> UnisonFile v a +leftBiasedMerge :: forall v a. (Ord v) => UnisonFile v a -> UnisonFile v a -> UnisonFile v a leftBiasedMerge lhs rhs = let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) (terms lhs) (terms rhs) mergedWatches = Map.foldlWithKey' addWatch (watches lhs) (watches rhs) @@ -340,7 +340,7 @@ dependencies (UnisonFile ds es ts ws) = <> foldMap (Term.dependencies . snd) ts <> foldMap (foldMap (Term.dependencies . view _3)) ws -discardTypes :: Ord v => TypecheckedUnisonFile v a -> UnisonFile v a +discardTypes :: (Ord v) => TypecheckedUnisonFile v a -> UnisonFile v a discardTypes (TypecheckedUnisonFileId datas effects terms watches _) = let watches' = g . mconcat <$> List.multimap watches g tup3s = [(v, a, e) | (v, a, e, _t) <- tup3s] diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 87f9fb6d12..00fdd5f115 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -28,7 +28,7 @@ import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind qualified as WK -toNames :: Var v => UnisonFile v a -> Names +toNames :: (Var v) => UnisonFile v a -> Names toNames uf = datas <> effects where datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf)) @@ -106,7 +106,7 @@ bindNames names (UnisonFileId d e ts ws) = do -- -- It's used below in `environmentFor` and also during the term resolution -- process. -variableCanonicalizer :: forall v. Var v => [v] -> Map v v +variableCanonicalizer :: forall v. (Var v) => [v] -> Map v v variableCanonicalizer vs = done $ List.multimap do v <- vs diff --git a/parser-typechecker/src/Unison/Util/Text.hs b/parser-typechecker/src/Unison/Util/Text.hs index 2c5bdf3c5b..c588e35743 100644 --- a/parser-typechecker/src/Unison/Util/Text.hs +++ b/parser-typechecker/src/Unison/Util/Text.hs @@ -6,6 +6,7 @@ module Unison.Util.Text where import Data.Foldable (toList) import Data.List (foldl', unfoldr) +import Data.List qualified as L import Data.String (IsString (..)) import Data.Text qualified as T import Data.Text.Encoding qualified as T @@ -131,6 +132,25 @@ indexOf needle haystack = needle' = toLazyText needle haystack' = toLazyText haystack +-- | Return the ordinal representation of a number in English. +-- A number ending with '1' must finish with 'st' +-- A number ending with '2' must finish with 'nd' +-- A number ending with '3' must finish with 'rd' +-- _except_ for 11, 12, and 13 which must finish with 'th' +ordinal :: (IsString s) => Int -> s +ordinal n = do + let s = show n + fromString $ + s ++ case L.drop (L.length s - 2) s of + ['1', '1'] -> "th" + ['1', '2'] -> "th" + ['1', '3'] -> "th" + _ -> case last s of + '1' -> "st" + '2' -> "nd" + '3' -> "rd" + _ -> "th" + -- Drop with both a maximum size and a predicate. Yields actual number of -- dropped characters. -- diff --git a/parser-typechecker/tests/Unison/Test/Codebase/Path.hs b/parser-typechecker/tests/Unison/Test/Codebase/Path.hs index 96fb0aca65..77cb80718e 100644 --- a/parser-typechecker/tests/Unison/Test/Codebase/Path.hs +++ b/parser-typechecker/tests/Unison/Test/Codebase/Path.hs @@ -6,7 +6,7 @@ import Data.Maybe (fromJust) import EasyTest import Unison.Codebase.Path (Path (..), Path' (..), Relative (..)) import Unison.Codebase.Path.Parse (parseHQSplit', parseShortHashOrHQSplit') -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude import Unison.ShortHash qualified as SH diff --git a/parser-typechecker/tests/Unison/Test/DataDeclaration.hs b/parser-typechecker/tests/Unison/Test/DataDeclaration.hs index f7e66a7ada..425d9bd267 100644 --- a/parser-typechecker/tests/Unison/Test/DataDeclaration.hs +++ b/parser-typechecker/tests/Unison/Test/DataDeclaration.hs @@ -88,7 +88,7 @@ unhashComponentTest = inventedVarsFreshnessTest = let var = Type.var () app = Type.app () - forall = Type.forall () + forAll = Type.forAll () (-->) = Type.arrow () h = Hash.fromByteString (encodeUtf8 "abcd") ref = R.Id h 0 @@ -104,8 +104,8 @@ unhashComponentTest = annotation = (), bound = [], constructors' = - [ ((), nil, forall a (listType `app` var a)), - ((), cons, forall b (var b --> listType `app` var b --> listType `app` var b)) + [ ((), nil, forAll a (listType `app` var a)), + ((), cons, forAll b (var b --> listType `app` var b --> listType `app` var b)) ] } component :: Map R.Id (Decl Symbol ()) @@ -120,7 +120,7 @@ unhashComponentTest = in tests [ -- check that `nil` constructor's type did not collapse to `forall a. a a`, -- which would happen if the var invented for `listRef` was simply `Var.refNamed listRef` - expectEqual (forall z (listType' `app` var z)) nilType', + expectEqual (forAll z (listType' `app` var z)) nilType', -- check that the variable assigned to `listRef` is different from `cons`, -- which would happen if the var invented for `listRef` was simply `Var.refNamed listRef` expectNotEqual cons listVar diff --git a/parser-typechecker/tests/Unison/Test/Term.hs b/parser-typechecker/tests/Unison/Test/Term.hs index ae75589ac6..4791382bd9 100644 --- a/parser-typechecker/tests/Unison/Test/Term.hs +++ b/parser-typechecker/tests/Unison/Test/Term.hs @@ -33,7 +33,7 @@ test = Type.arrow () (tv "a") (tv "x") ) ) - (Type.forall () (v "a") (tv "a")) + (Type.forAll () (v "a") (tv "a")) tm' = Term.substTypeVar (v "x") (tv "a") tm expected = Term.ann @@ -45,7 +45,7 @@ test = Type.arrow () (Type.var () $ v1 "a") (tv "a") ) ) - (Type.forall () (v1 "a") (Type.var () $ v1 "a")) + (Type.forAll () (v1 "a") (Type.var () $ v1 "a")) note $ show tm' note $ show expected expect $ tm == tm @@ -57,7 +57,7 @@ test = ref = R.Id h 0 v1 = Var.unnamedRef @Symbol ref -- input component: `ref = \v1 -> ref` - component = Map.singleton ref (Term.lam () v1 (Term.refId () ref)) + component = Map.singleton ref (Term.lam () ((), v1) (Term.refId () ref)) component' = Term.unhashComponent component -- expected unhashed component: `v2 = \v1 -> v2`, where `v2 /= v1`, -- i.e. `v2` cannot be just `ref` converted to a ref-named variable, diff --git a/parser-typechecker/tests/Unison/Test/Type.hs b/parser-typechecker/tests/Unison/Test/Type.hs index de22ec80bf..767addedcd 100644 --- a/parser-typechecker/tests/Unison/Test/Type.hs +++ b/parser-typechecker/tests/Unison/Test/Type.hs @@ -28,7 +28,7 @@ test = v2 = Var.named "b" vt = var () v vt2 = var () v2 - x = forall () v (nat () --> effect () [vt, builtin () "eff"] (nat ())) :: Type Symbol () - y = forall () v2 (nat () --> effect () [vt2] (nat ())) :: Type Symbol () + x = forAll () v (nat () --> effect () [vt, builtin () "eff"] (nat ())) :: Type Symbol () + y = forAll () v2 (nat () --> effect () [vt2] (nat ())) :: Type Symbol () expect . not $ Typechecker.isSubtype x y ] diff --git a/parser-typechecker/tests/Unison/Test/Typechecker.hs b/parser-typechecker/tests/Unison/Test/Typechecker.hs index 6fe94b59be..ce39af19c2 100644 --- a/parser-typechecker/tests/Unison/Test/Typechecker.hs +++ b/parser-typechecker/tests/Unison/Test/Typechecker.hs @@ -18,12 +18,12 @@ test = isSubtypeTest :: Test () isSubtypeTest = let symbol i n = Symbol i (Var.User n) - forall v t = Type.forall () v t + forAll v t = Type.forAll () v t var v = Type.var () v a = symbol 0 "a" a_ i = symbol i "a" - lhs = forall a (var a) -- ∀a. a + lhs = forAll a (var a) -- ∀a. a rhs_ i = var (a_ i) -- a_i in -- check that `∀a. a <: a_i` (used to fail for i = 2, 3) tests [expectSubtype lhs (rhs_ i) | i <- [0 .. 5]] diff --git a/parser-typechecker/tests/Unison/Test/Util/Text.hs b/parser-typechecker/tests/Unison/Test/Util/Text.hs index e5e13e9d55..245ca3424e 100644 --- a/parser-typechecker/tests/Unison/Test/Util/Text.hs +++ b/parser-typechecker/tests/Unison/Test/Util/Text.hs @@ -46,10 +46,8 @@ test = scope "<>" . expect' $ Text.toText (t1s <> t2s <> t3s) == t1 <> t2 <> t3 scope "Ord" . expect' $ - (t1 <> t2 <> t3) - `compare` t3 - == (t1s <> t2s <> t3s) - `compare` t3s + (t1 <> t2 <> t3) `compare` t3 + == (t1s <> t2s <> t3s) `compare` t3s scope "take" . expect' $ Text.toText (Text.take k (t1s <> t2s)) == T.take k (t1 <> t2) scope "drop" . expect' $ @@ -178,7 +176,28 @@ test = ) (P.Join [P.Capture (P.Literal "zzzaaa"), P.Capture (P.Literal "!")]) in P.run p "zzzaaa!!!" - ok + ok, + scope "ordinal" do + expectEqual (Text.ordinal 1) ("1st" :: String) + expectEqual (Text.ordinal 2) ("2nd" :: String) + expectEqual (Text.ordinal 3) ("3rd" :: String) + expectEqual (Text.ordinal 4) ("4th" :: String) + expectEqual (Text.ordinal 5) ("5th" :: String) + expectEqual (Text.ordinal 10) ("10th" :: String) + expectEqual (Text.ordinal 11) ("11th" :: String) + expectEqual (Text.ordinal 12) ("12th" :: String) + expectEqual (Text.ordinal 13) ("13th" :: String) + expectEqual (Text.ordinal 14) ("14th" :: String) + expectEqual (Text.ordinal 21) ("21st" :: String) + expectEqual (Text.ordinal 22) ("22nd" :: String) + expectEqual (Text.ordinal 23) ("23rd" :: String) + expectEqual (Text.ordinal 24) ("24th" :: String) + expectEqual (Text.ordinal 111) ("111th" :: String) + expectEqual (Text.ordinal 112) ("112th" :: String) + expectEqual (Text.ordinal 113) ("113th" :: String) + expectEqual (Text.ordinal 121) ("121st" :: String) + expectEqual (Text.ordinal 122) ("122nd" :: String) + expectEqual (Text.ordinal 123) ("123rd" :: String) ] where log2 :: Int -> Int diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 7a9a467093..018ec3eb7b 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -60,8 +60,8 @@ library Unison.Codebase.Patch Unison.Codebase.Path Unison.Codebase.Path.Parse + Unison.Codebase.ProjectPath Unison.Codebase.PushBehavior - Unison.Codebase.RootBranchCache Unison.Codebase.Runtime Unison.Codebase.Serialization Unison.Codebase.ShortCausalHash @@ -72,6 +72,7 @@ library Unison.Codebase.SqliteCodebase.Migrations Unison.Codebase.SqliteCodebase.Migrations.Helpers Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 + Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2.DbHelpers Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema3To4 @@ -131,7 +132,6 @@ library Unison.PrettyPrintEnvDecl.Names Unison.PrettyPrintEnvDecl.Sqlite Unison.PrintError - Unison.Project.Util Unison.Result Unison.Runtime.ANF Unison.Runtime.ANF.Rehash @@ -224,7 +224,6 @@ library build-depends: IntervalMap , ListLike - , NanoID , aeson , ansi-terminal , asn1-encoding @@ -244,6 +243,9 @@ library , concurrent-output , configurator , containers >=0.6.3 + , crypton-x509 + , crypton-x509-store + , crypton-x509-system , cryptonite , data-default , data-memocombinators @@ -284,7 +286,7 @@ library , nonempty-containers , open-browser , openapi3 - , optparse-applicative >=0.16.1.0 + , optparse-applicative , pem , pretty-simple , primitive @@ -330,7 +332,6 @@ library , unison-util-base32hex , unison-util-bytes , unison-util-cache - , unison-util-nametree , unison-util-relation , unison-util-rope , unison-util-serialization @@ -343,9 +344,6 @@ library , warp , witch , witherable - , x509 - , x509-store - , x509-system , yaml , zlib default-language: Haskell2010 @@ -420,7 +418,6 @@ test-suite parser-typechecker-tests build-depends: IntervalMap , ListLike - , NanoID , aeson , ansi-terminal , asn1-encoding @@ -441,6 +438,9 @@ test-suite parser-typechecker-tests , concurrent-output , configurator , containers >=0.6.3 + , crypton-x509 + , crypton-x509-store + , crypton-x509-system , cryptonite , data-default , data-memocombinators @@ -484,7 +484,7 @@ test-suite parser-typechecker-tests , nonempty-containers , open-browser , openapi3 - , optparse-applicative >=0.16.1.0 + , optparse-applicative , pem , pretty-simple , primitive @@ -532,7 +532,6 @@ test-suite parser-typechecker-tests , unison-util-base32hex , unison-util-bytes , unison-util-cache - , unison-util-nametree , unison-util-relation , unison-util-rope , unison-util-serialization @@ -545,9 +544,6 @@ test-suite parser-typechecker-tests , warp , witch , witherable - , x509 - , x509-store - , x509-system , yaml , zlib default-language: Haskell2010 diff --git a/scheme-libs/racket/unison/arithmetic.rkt b/scheme-libs/racket/unison/arithmetic.rkt index d9a63d9eb5..a50364eb55 100644 --- a/scheme-libs/racket/unison/arithmetic.rkt +++ b/scheme-libs/racket/unison/arithmetic.rkt @@ -1,70 +1,103 @@ #!racket/base (provide - (prefix-out - builtin- - (combine-out - Nat.toFloat - Nat.increment - Nat.+ - Nat.drop - Float.* - Float.fromRepresentation - Float.toRepresentation - Float.ceiling - Int.+ - Int.- - Int./ - Int.increment - Int.negate - Int.fromRepresentation - Int.toRepresentation - Int.signum - ))) + builtin-Nat.+ + builtin-Nat.+:termlink + builtin-Nat.toFloat + builtin-Nat.toFloat:termlink + builtin-Nat.increment + builtin-Nat.increment:termlink + builtin-Nat.drop + builtin-Nat.drop:termlink + builtin-Float.* + builtin-Float.*:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.ceiling + builtin-Float.ceiling:termlink + builtin-Int.+ + builtin-Int.+:termlink + builtin-Int.- + builtin-Int.-:termlink + builtin-Int./ + builtin-Int./:termlink + builtin-Int.increment + builtin-Int.increment:termlink + builtin-Int.negate + builtin-Int.negate:termlink + builtin-Int.fromRepresentation + builtin-Int.fromRepresentation:termlink + builtin-Int.toRepresentation + builtin-Int.toRepresentation:termlink + builtin-Int.signum + builtin-Int.signum:termlink) (require racket racket/fixnum racket/flonum racket/performance-hint + unison/data unison/boot) (begin-encourage-inline - (define-unison (Nat.+ m n) (clamp-natural (+ m n))) - (define-unison (Nat.drop m n) (max 0 (- m n))) + (define-unison-builtin + (builtin-Nat.+ m n) + (clamp-natural (+ m n))) - (define-unison (Nat.increment n) (clamp-natural (add1 n))) - (define-unison (Int.increment i) (clamp-integer (add1 i))) - (define-unison (Int.negate i) (if (> i nbit63) (- i) i)) - (define-unison (Int.+ i j) (clamp-integer (+ i j))) - (define-unison (Int.- i j) (clamp-integer (- i j))) - (define-unison (Int./ i j) (floor (/ i j))) - (define-unison (Int.signum i) (sgn i)) - (define-unison (Float.* x y) (fl* x y)) + (define-unison-builtin + (builtin-Nat.drop m n) + (max 0 (- m n))) - (define-unison (Nat.toFloat n) (->fl n)) + (define-unison-builtin + (builtin-Nat.increment n) + (clamp-natural (add1 n))) + (define-unison-builtin + (builtin-Int.increment i) (clamp-integer (add1 i))) + (define-unison-builtin + (builtin-Int.negate i) (if (> i nbit63) (- i) i)) + (define-unison-builtin + (builtin-Int.+ i j) (clamp-integer (+ i j))) + (define-unison-builtin + (builtin-Int.- i j) (clamp-integer (- i j))) + (define-unison-builtin + (builtin-Int./ i j) (floor (/ i j))) + (define-unison-builtin + (builtin-Int.signum i) (sgn i)) + (define-unison-builtin + (builtin-Float.* x y) (fl* x y)) - (define-unison (Float.ceiling f) + (define-unison-builtin + (builtin-Nat.toFloat n) (->fl n)) + + (define-unison-builtin + (builtin-Float.ceiling f) (clamp-integer (fl->exact-integer (ceiling f)))) ; If someone can suggest a better mechanism for these, ; that would be appreciated. - (define-unison (Float.toRepresentation fl) + (define-unison-builtin + (builtin-Float.toRepresentation fl) (integer-bytes->integer (real->floating-point-bytes fl 8 #t) ; big endian #f ; unsigned #t)) ; big endian - (define-unison (Float.fromRepresentation n) + (define-unison-builtin + (builtin-Float.fromRepresentation n) (floating-point-bytes->real (integer->integer-bytes n 8 #f #t) ; unsigned, big endian #t)) ; big endian - (define-unison (Int.toRepresentation i) + (define-unison-builtin + (builtin-Int.toRepresentation i) (integer-bytes->integer (integer->integer-bytes i 8 #t #t) ; signed, big endian #f #t)) ; unsigned, big endian - (define-unison (Int.fromRepresentation n) + (define-unison-builtin + (builtin-Int.fromRepresentation n) (integer-bytes->integer (integer->integer-bytes n 8 #f #t) ; unsigned, big endian #t #t)) ; signed, big endian diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index 67d390f9cf..ed8b0f7d35 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -55,6 +55,7 @@ bytes control define-unison + define-unison-builtin handle name data @@ -116,14 +117,16 @@ (require (for-syntax racket/set - (only-in racket partition flatten)) + (only-in racket partition flatten split-at) + (only-in racket/string string-prefix?) + (only-in racket/syntax format-id)) (rename-in (except-in racket false true unit any) [make-continuation-prompt-tag make-prompt]) ; (for (only (compatibility mlist) mlist->list list->mlist) expand) ; (for (only (racket base) quasisyntax/loc) expand) ; (for-syntax (only-in unison/core syntax->list)) - (only-in racket/control prompt0-at control0-at) + (only-in racket/control control0-at) racket/performance-hint unison/core unison/data @@ -151,115 +154,301 @@ (syntax-rules () [(with-name name e) (let ([name e]) name)])) -; function definition with slow/fast path. Slow path allows for -; under/overapplication. Fast path is exact application. +; Our definition macro needs to generate multiple entry points for the +; defined procedures, so this is a function for making up names for +; those based on the original. +(define-for-syntax (adjust-symbol name post) + (string->symbol + (string-append + (symbol->string name) + ":" + post))) + +(define-for-syntax (adjust-name name post) + (datum->syntax name (adjust-symbol (syntax->datum name) post) name)) + +; Helper function. Turns a list of syntax objects into a +; list-syntax object. +(define-for-syntax (list->syntax l) #`(#,@l)) + +; These are auxiliary functions for manipulating a unison definition +; into a form amenable for the right runtime behavior. This involves +; multiple separate definitions: ; -; The intent is for the scheme compiler to be able to recognize and -; optimize static, fast path calls itself, while still supporting -; unison-like automatic partial application and such. -(define-syntax (define-unison x) - (define (fast-path-symbol name) - (string->symbol - (string-append - (symbol->string name) - ":fast-path"))) - - (define (fast-path-name name) - (datum->syntax name (fast-path-symbol (syntax->datum name)))) - - ; Helper function. Turns a list of syntax objects into a - ; list-syntax object. - (define (list->syntax l) #`(#,@l)) - ; Builds partial application cases for unison functions. - ; It seems most efficient to have a case for each posible - ; under-application. - (define (build-partials name formals) - (let rec ([us formals] [acc '()]) - (syntax-case us () - [() (list->syntax (cons #`[() #,name] acc))] - [(a ... z) - (rec #'(a ...) - (cons - #`[(a ... z) - (with-name - #,(datum->syntax name (syntax->datum name)) - (partial-app #,name a ... z))] - acc))]))) - - ; Given an overall function name, a fast path name, and a list of - ; arguments, builds the case-lambda body of a unison function that - ; enables applying to arbitrary numbers of arguments. - (define (func-cases name name:fast args) - (syntax-case args () - [() (quasisyntax/loc x - (case-lambda - [() (#,name:fast)] - [r (apply (#,name:fast) r)]))] - [(a ... z) - (quasisyntax/loc x - (case-lambda - #,@(build-partials name #'(a ...)) - [(a ... z) (#,name:fast a ... z)] - [(a ... z . r) (apply (#,name:fast a ... z) r)]))])) - - (syntax-case x () - [(define-unison (name a ...) e ...) - (let ([fname (fast-path-name #'name)]) - (with-syntax ([name:fast fname] - [fast (syntax/loc x (lambda (a ...) e ...))] - [slow (func-cases #'name fname #'(a ...))]) - (syntax/loc x - (define-values (name:fast name) (values fast slow)))))])) +; 1. an :impl definition is generated containing the actual code body +; 2. a :fast definition, which takes exactly the number of arguments +; as the original, but checks if stack information needs to be +; stored for continuation serialization. +; 3. a :slow path which implements under/over application to unison +; definitions, so they act like curried functions, not scheme +; procedures +; 4. a macro that implements the actual occurrences, and directly +; calls the fast path for static calls with exactly the right +; number of arguments +; +; Additionally, arguments are threaded through the internal +; definitions that indicate whether an ability handler is in place +; that could potentially result in the continuation being serialized. +; If so, then calls write additional information to the continuation +; for that serialization. This isn't cheap for tight loops, so we +; attempt to avoid this as much as possible (conditioning the +; annotation on a flag checkseems to cause no performance loss). + + +; This builds the core definition for a unison definition. It is just +; a lambda expression with the original code, but with an additional +; keyword argument for threading purity information. +(define-for-syntax (make-impl name:impl:stx arg:stx body:stx) + (with-syntax ([name:impl name:impl:stx] + [args arg:stx] + [body body:stx]) + (syntax/loc body:stx + (define (name:impl #:pure pure? . args) . body)))) + +(define frame-contents (gensym)) + +; Builds the wrapper definition, 'fast path,' which just tests the +; purity, writes the stack information if necessary, and calls the +; implementation. If #:force-pure is specified, the fast path just +; directly calls the implementation procedure. This should allow +; tight loops to still perform well if we can detect that they +; (hereditarily) cannot make ability requests, even in contexts +; where a handler is present. +(define-for-syntax + (make-fast-path + #:force-pure force-pure? + loc ; original location + name:fast:stx name:impl:stx + arg:stx) + + (with-syntax ([name:impl name:impl:stx] + [name:fast name:fast:stx] + [args arg:stx]) + (if force-pure? + (syntax/loc loc + (define name:fast name:impl)) + + (syntax/loc loc + (define (name:fast #:pure pure? . args) + (if pure? + (name:impl #:pure pure? . args) + (with-continuation-mark + frame-contents + (vector . args) + (name:impl #:pure pure? . args)))))))) + +; Slow path -- unnecessary +; (define-for-syntax (make-slow-path loc name argstx) +; (with-syntax ([name:slow (adjust-symbol name "slow")] +; [n (length (syntax->list argstx))]) +; (syntax/loc loc +; (define (name:slow #:pure pure? . as) +; (define k (length as)) +; (cond +; [(< k n) (unison-closure n name:slow as)] +; [(= k n) (apply name:fast #:pure pure? as)] +; [(> k n) +; (define-values (h t) (split-at as n)) +; (apply +; (apply name:fast #:pure pure? h) +; #:pure pure? +; t)]))))) + +; This definition builds a macro that defines the behavior of actual +; occurences of the definition names. It has the following behavior: +; +; 1. Exactly saturated occurences directly call the fast path +; 2. Undersaturated or unapplied occurrences become closure +; construction +; 3. Oversaturated occurrences become an appropriate nested +; application +; +; Because of point 2, all function values end up represented as +; unison-closure objects, so a slow path procedure is no longer +; necessary; it is handled by the prop:procedure of the closure +; structure. This should also make various universal operations easier +; to handle, because we can just test for unison-closures, instead of +; having to deal with raw procedures. +(define-for-syntax + (make-callsite-macro + #:internal internal? + loc ; original location + name:stx name:fast:stx + arity:val) + (with-syntax ([name name:stx] + [name:fast name:fast:stx] + [arity arity:val]) + (cond + [internal? + (syntax/loc loc + (define-syntax (name stx) + (syntax-case stx () + [(_ #:by-name _ . bs) + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(_ . bs) + (let ([k (length (syntax->list #'bs))]) + (cond + [(= arity k) ; saturated + (syntax/loc stx + (name:fast #:pure #t . bs))] + [(> arity k) ; undersaturated + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(< arity k) ; oversaturated + (define-values (h t) + (split-at (syntax->list #'bs) arity)) + + (quasisyntax/loc stx + ((name:fast #:pure #t #,@h) #,@t))]))] + [_ (syntax/loc stx + (unison-closure arity name:fast (list)))])))] + [else + (syntax/loc loc + (define-syntax (name stx) + (syntax-case stx () + [(_ #:by-name _ . bs) + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(_ . bs) + (let ([k (length (syntax->list #'bs))]) + + ; todo: purity + + ; capture local pure? + (with-syntax ([pure? (format-id stx "pure?")]) + (cond + [(= arity k) ; saturated + (syntax/loc stx + (name:fast #:pure pure? . bs))] + [(> arity k) + (syntax/loc stx + (unison-closure n name:fast (list . bs)))] + [(< arity k) ; oversaturated + (define-values (h t) + (split-at (syntax->list #'bs) arity)) + + ; TODO: pending argument frame + (quasisyntax/loc stx + ((name:fast #:pure pure? #,@h) + #:pure pure? + #,@t))])))] + ; non-applied occurrence; partial ap immediately + [_ (syntax/loc stx + (unison-closure arity name:fast (list)))])))]))) + +(define-for-syntax + (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx) + (if no-link-decl? + #'() + (let ([name:link:stx (adjust-name name:stx "termlink")]) + (with-syntax + ([name:fast name:fast:stx] + [name:impl name:impl:stx] + [name:link name:link:stx]) + (syntax/loc loc + ((declare-function-link name:fast name:link) + (declare-function-link name:impl name:link))))))) + +(define-for-syntax (process-hints hs) + (for/fold ([internal? #f] + [force-pure? #t] + [gen-link? #f] + [no-link-decl? #f]) + ([h hs]) + (values + (or internal? (eq? h 'internal)) + (or force-pure? (eq? h 'force-pure) (eq? h 'internal)) + (or gen-link? (eq? h 'gen-link)) + (or no-link-decl? (eq? h 'no-link-decl))))) + +(define-for-syntax + (make-link-def gen-link? loc name:stx name:link:stx) + + (define (chop s) + (if (string-prefix? s "builtin-") + (substring s 8) + s)) + + (define name:txt + (chop + (symbol->string + (syntax->datum name:stx)))) + + (cond + [gen-link? + (with-syntax ([name:link name:link:stx]) + (quasisyntax/loc loc + ((define name:link + (unison-termlink-builtin #,name:txt)))))] + [else #'()])) + +(define-for-syntax + (expand-define-unison + #:hints hints + loc name:stx arg:stx expr:stx) + + (define-values + (internal? force-pure? gen-link? no-link-decl?) + (process-hints hints)) + + (let ([name:fast:stx (adjust-name name:stx "fast")] + [name:impl:stx (adjust-name name:stx "impl")] + [name:link:stx (adjust-name name:stx "termlink")] + [arity (length (syntax->list arg:stx))]) + (with-syntax + ([(link ...) (make-link-def gen-link? loc name:stx name:link:stx)] + [fast (make-fast-path + #:force-pure force-pure? + loc name:fast:stx name:impl:stx arg:stx)] + [impl (make-impl name:impl:stx arg:stx expr:stx)] + [call (make-callsite-macro + #:internal internal? + loc name:stx name:fast:stx arity)] + [(decls ...) + (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)]) + (syntax/loc loc + (begin link ... impl fast call decls ...))))) + +; Function definition supporting various unison features, like +; partial application and continuation serialization. See above for +; details. +; +; `#:internal #t` indicates that the definition is for builtin +; functions. These should always be built in a way that does not +; annotate the stack, because they don't make relevant ability +; requests. This is important for performance and some correct +; behavior (i.e. they may occur in non-unison contexts where a +; `pure?` indicator is not being threaded). +(define-syntax (define-unison stx) + (syntax-case stx () + [(define-unison #:hints hs (name . args) . exprs) + (expand-define-unison + #:hints (syntax->datum #'hs) + stx #'name #'args #'exprs)] + [(define-unison (name . args) . exprs) + (expand-define-unison + #:hints '[internal] + stx #'name #'args #'exprs)])) + +(define-syntax (define-unison-builtin stx) + (syntax-case stx () + [(define-unison-builtin . rest) + (syntax/loc stx + (define-unison #:hints [internal gen-link] . rest))])) ; call-by-name bindings -(define-syntax name - (lambda (stx) - (syntax-case stx () - ((name ([v (f . args)] ...) body ...) - (with-syntax ([(lam ...) - (map (lambda (body) - (quasisyntax/loc stx - (lambda r #,body))) - (syntax->list #'[(apply f (append (list . args) r)) ...]))]) - #`(let ([v lam] ...) - body ...)))))) +(define-syntax (name stx) + (syntax-case stx () + [(name ([v (f . args)] ...) body ...) + (syntax/loc stx + (let ([v (f #:by-name #t . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs -; -; Note: this uses the prompt _twice_ to achieve the sort of dynamic -; scoping we want. First we push an outer delimiter, then install -; the continuation marks corresponding to the handled abilities -; (which tells which propt to use for that ability and which -; functions to use for each request). Then we re-delimit by the same -; prompt. -; -; If we just used one delimiter, we'd have a problem. If we pushed -; the marks _after_ the delimiter, then the continuation captured -; when handling would contain those marks, and would effectively -; retain the handler for requests within the continuation. If the -; marks were outside the prompt, we'd be in a similar situation, -; except where the handler would be automatically handling requests -; within its own implementation (although, in both these cases we'd -; get control errors, because we would be using the _function_ part -; of the handler without the necessary delimiters existing on the -; continuation). Both of these situations are wrong for _shallow_ -; handlers. -; -; Instead, what we need to be able to do is capture the continuation -; _up to_ the marks, then _discard_ the marks, and this is what the -; multiple delimiters accomplish. There might be more efficient ways -; to accomplish this with some specialized mark functions, but I'm -; uncertain of what pitfalls there are with regard to that (whehter -; they work might depend on exact frame structure of the -; metacontinuation). (define-syntax handle (syntax-rules () [(handle [r ...] h e ...) - (let ([p (make-prompt)]) - (prompt0-at p - (let ([v (let-marks (list r ...) (cons p h) - (prompt0-at p e ...))]) - (h (make-pure v)))))])) + (call-with-handler (list r ...) h (lambda () e ...))])) ; wrapper that more closely matches ability requests (define-syntax request diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 2049e23b37..a929ad77c8 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -66,17 +66,17 @@ [cas! (lambda () (unsafe-struct*-cas! promise 2 value (some new-value)))] [awake-readers (lambda () (semaphore-post (promise-semaphore promise)))]) (cond - [(some? value) false] + [(some? value) sum-false] [else - (let ([ok (parameterize-break #f (if (cas!) (awake-readers) false))]) - (if ok true (loop)))])))) + (let ([ok (parameterize-break #f (if (cas!) (awake-readers) sum-false))]) + (if ok sum-true (loop)))])))) (define (ref-cas ref ticket value) - (if (box-cas! ref ticket value) true false)) + (if (box-cas! ref ticket value) sum-true sum-false)) (define (sleep n) (sleep-secs (/ n 1000000)) - (right unit)) + (right sum-unit)) ;; Swallows uncaught breaks/thread kills rather than logging them to ;; match the behaviour of the Haskell runtime @@ -88,5 +88,5 @@ (define (kill threadId) (break-thread threadId) - (right unit)) + (right sum-unit)) ) diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index a273938150..0985c20464 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -23,6 +23,7 @@ (struct-out exn:bug) let-marks + call-with-marks ref-mark chunked-string-foldMap-chunks @@ -192,7 +193,9 @@ (string-append "{Value " (describe-value v) "}")] [(unison-code v) (string-append "{Code " (describe-value v) "}")] - [(unison-closure code env) + [(unison-cont-reflected fs) "{Continuation}"] + [(unison-cont-wrapped _) "{Continuation}"] + [(unison-closure _ code env) (define dc (termlink->string (lookup-function-link code) #t)) (define (f v) @@ -437,13 +440,6 @@ ; [() '()] ; [(x . xs) (cons #'x (syntax->list #'xs))])) -(define (call-with-marks rs v f) - (cond - [(null? rs) (f)] - [else - (with-continuation-mark (car rs) v - (call-with-marks (cdr rs) v f))])) - (define-syntax let-marks (syntax-rules () [(let-marks ks bn e ...) diff --git a/scheme-libs/racket/unison/crypto.rkt b/scheme-libs/racket/unison/crypto.rkt index 4d25dc3d9b..971056e36c 100644 --- a/scheme-libs/racket/unison/crypto.rkt +++ b/scheme-libs/racket/unison/crypto.rkt @@ -96,6 +96,7 @@ (error 'blake2 "~a failed with return value ~a" fn r)))))) (define blake2b-raw (libb2-raw "blake2b")) +(define blake2s-raw (libb2-raw "blake2s")) (define HashAlgorithm.Md5 (lc-algo "EVP_md5" 128)) (define HashAlgorithm.Sha1 (lc-algo "EVP_sha1" 160)) @@ -103,8 +104,6 @@ (define HashAlgorithm.Sha2_512 (lc-algo "EVP_sha512" 512)) (define HashAlgorithm.Sha3_256 (lc-algo "EVP_sha3_256" 256)) (define HashAlgorithm.Sha3_512 (lc-algo "EVP_sha3_512" 512)) -(define HashAlgorithm.Blake2s_256 (lc-algo "EVP_blake2s256" 256)) -(define HashAlgorithm.Blake2b_512 (lc-algo "EVP_blake2b512" 512)) (define _EVP_PKEY-pointer (_cpointer 'EVP_PKEY)) (define _EVP_MD_CTX-pointer (_cpointer 'EVP_MD_CTX)) @@ -234,6 +233,8 @@ (chunked-bytes->bytes input) (chunked-bytes->bytes signature))) +(define (HashAlgorithm.Blake2s_256) (cons 'blake2s 256)) +(define (HashAlgorithm.Blake2b_512) (cons 'blake2b 512)) ; This one isn't provided by libcrypto, for some reason (define (HashAlgorithm.Blake2b_256) (cons 'blake2b 256)) @@ -252,6 +253,7 @@ [algo (car kind)]) (case algo ['blake2b (blake2b-raw output input #f bytes (bytes-length input) 0)] + ['blake2s (blake2s-raw output input #f bytes (bytes-length input) 0)] [else (EVP_Digest input (bytes-length input) output #f algo #f)]) output)) @@ -294,6 +296,7 @@ (define (hmacBytes-raw kind key input) (case (car kind) ['blake2b (hmacBlake kind key input)] + ['blake2s (hmacBlake kind key input)] [else (let* ([bytes (/ (cdr kind) 8)] [output (make-bytes bytes)] diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index 7ab75d6d5b..a110be41f2 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -12,6 +12,12 @@ have-code? (struct-out unison-data) + (struct-out unison-continuation) + (struct-out unison-cont-wrapped) + (struct-out unison-cont-reflected) + (struct-out unison-frame) + (struct-out unison-frame-push) + (struct-out unison-frame-mark) (struct-out unison-sum) (struct-out unison-pure) (struct-out unison-request) @@ -27,6 +33,9 @@ (struct-out unison-quote) (struct-out unison-timespec) + call-with-handler + call-with-marks + define-builtin-link declare-builtin-link @@ -45,9 +54,9 @@ left? either-get either-get - unit - false - true + sum-unit + sum-false + sum-true bool char ord @@ -100,12 +109,15 @@ builtin-tls.version:typelink unison-tuple->list + unison-pair->cons typelink->string termlink->string) (require - racket + (rename-in racket + [make-continuation-prompt-tag make-prompt]) + (only-in racket/control prompt0-at control0-at) racket/fixnum (only-in "vector-trie.rkt" ->fx/wraparound) unison/bytevector) @@ -290,13 +302,10 @@ (write-string ")" port)) (struct unison-closure - (code env) + (arity code env) #:transparent #:methods gen:custom-write [(define (write-proc clo port mode) - (define code-tl - (lookup-function-link (unison-closure-code clo))) - (define rec (case mode [(#t) write] @@ -308,12 +317,31 @@ (write-string " " port) (write-sequence (unison-closure-env clo) port mode) (write-string ")" port))] + + ; This has essentially becomes the slow path for unison function + ; application. The definition macro immediately creates a closure + ; for any statically under-saturated call or unapplied occurrence. + ; This means that there is never a bare unison function being passed + ; as a value. So, we can define the slow path here once and for all. #:property prop:procedure - (case-lambda - [(clo) clo] - [(clo . rest) - (apply (unison-closure-code clo) - (append (unison-closure-env clo) rest))])) + (lambda (clo #:pure [pure? #f] #:by-name [by-name? #f] . rest) + (define arity (unison-closure-arity clo)) + (define old-env (unison-closure-env clo)) + (define code (unison-closure-code clo)) + + (define new-env (append old-env rest)) + (define k (length rest)) + (define l (length new-env)) + (cond + [(or by-name? (> arity l)) + (struct-copy unison-closure clo [env new-env])] + [(= arity l) ; saturated + (apply code #:pure pure? new-env)] + [(= k 0) clo] ; special case, 0-applying undersaturated + [(< arity l) + ; TODO: pending arg annotation if no pure? + (define-values (now pending) (split-at new-env arity)) + (apply (apply code #:pure pure? now) #:pure pure? pending)]))) (struct unison-timespec (sec nsec) #:transparent @@ -335,6 +363,115 @@ (list equal-proc (hash-proc 3) (hash-proc 5)))) +; This is the base struct for continuation representations. It has +; two possibilities seen below. +(struct unison-continuation () #:transparent) + +; This is a wrapper that allows for a struct representation of all +; continuations involved in unison. I.E. instead of just passing +; around a raw racket continuation, we wrap it in a box for easier +; identification. +(struct unison-cont-wrapped unison-continuation (cont) + ; Use the wrapped continuation for procedure calls. Continuations + ; will always be called via the jumpCont wrapper which exactly + ; applies them to one argument. + #:property prop:procedure 0) + +; Basic mechanism for installing handlers, defined here so that it +; can be used in the implementation of reflected continuations. +; +; Note: this uses the prompt _twice_ to achieve the sort of dynamic +; scoping we want. First we push an outer delimiter, then install +; the continuation marks corresponding to the handled abilities +; (which tells which propt to use for that ability and which +; functions to use for each request). Then we re-delimit by the same +; prompt. +; +; If we just used one delimiter, we'd have a problem. If we pushed +; the marks _after_ the delimiter, then the continuation captured +; when handling would contain those marks, and would effectively +; retain the handler for requests within the continuation. If the +; marks were outside the prompt, we'd be in a similar situation, +; except where the handler would be automatically handling requests +; within its own implementation (although, in both these cases we'd +; get control errors, because we would be using the _function_ part +; of the handler without the necessary delimiters existing on the +; continuation). Both of these situations are wrong for _shallow_ +; handlers. +; +; Instead, what we need to be able to do is capture the continuation +; _up to_ the marks, then _discard_ the marks, and this is what the +; multiple delimiters accomplish. There might be more efficient ways +; to accomplish this with some specialized mark functions, but I'm +; uncertain of what pitfalls there are with regard to that (whehter +; they work might depend on exact frame structure of the +; metacontinuation). +(define (call-with-handler rs h f) + (let ([p (make-prompt)]) + (prompt0-at p + (let ([v (call-with-marks rs (cons p h) + (lambda () (prompt0-at p (f))))]) + (h (make-pure v)))))) + +(define (call-with-marks rs v f) + (cond + [(null? rs) (f)] + [else + (with-continuation-mark (car rs) v + (call-with-marks (cdr rs) v f))])) + +; Version of the above for re-installing a handlers in the serialized +; format. In that case, there is an association list of links and +; handlers, rather than a single handler (although the separate +; handlers are likely duplicates). +(define (call-with-assoc-marks p hs f) + (match hs + ['() (f)] + [(cons (cons r h) rest) + (with-continuation-mark r (cons p h) + (call-with-assoc-marks rest f))])) + +(define (call-with-handler-assocs hs f) + (let ([p (make-prompt)]) + (prompt0-at p + (call-with-assoc-marks p hs + (lambda () (prompt0-at p (f))))))) + +(define (repush frames v) + (match frames + ['() v] + [(cons (unison-frame-mark as tls hs) frames) + ; handler frame; as are pending arguments, tls are typelinks + ; for handled abilities; hs are associations from links to + ; handler values. + ; + ; todo: args + (call-with-handler-assocs hs + (lambda () (repush frames v)))] + [(cons (unison-frame-push ls as rt) rest) + (displayln (list ls as rt)) + (raise "repush push: not implemented yet")])) + +; This is a *reflected* representation of continuations amenable +; to serialization. Most continuations won't be in this format, +; because it's foolish to eagerly parse the racket continuation if +; it's just going to be applied. But, a continuation that we've +; gotten from serialization will be in this format. +; +; `frames` should be a list of the below `unison-frame` structs. +(struct unison-cont-reflected unison-continuation (frames) + #:property prop:procedure + (lambda (cont v) (repush (unison-cont-reflected-frames cont) v))) + +; Stack frames for reflected continuations +(struct unison-frame () #:transparent) + +(struct unison-frame-push unison-frame + (locals args return-to)) + +(struct unison-frame-mark unison-frame + (args abilities handlers)) + (define-syntax (define-builtin-link stx) (syntax-case stx () [(_ name) @@ -344,9 +481,11 @@ [dname (datum->syntax stx (string->symbol (string-append - "builtin-" txt ":termlink")))]) - #`(define #,dname - (unison-termlink-builtin #,(datum->syntax stx txt))))])) + "builtin-" txt ":termlink")) + #'name)]) + (quasisyntax/loc stx + (define #,dname + (unison-termlink-builtin #,(datum->syntax stx txt)))))])) (define-syntax (declare-builtin-link stx) (syntax-case stx () @@ -357,7 +496,8 @@ [dname (datum->syntax stx (string->symbol (string-append txt ":termlink")))]) - #`(declare-function-link name #,dname))])) + (quasisyntax/loc stx + (declare-function-link name #,dname)))])) (define (partial-app f . args) (unison-closure f args)) @@ -382,11 +522,11 @@ ; # works as well ; Unit -(define unit (sum 0)) +(define sum-unit (sum 0)) ; Booleans are represented as numbers -(define false 0) -(define true 1) +(define sum-false 0) +(define sum-true 1) (define (bool b) (if b 1 0)) @@ -542,6 +682,13 @@ [else (raise "unison-tuple->list: unexpected value")]))) +(define (unison-pair->cons t) + (match t + [(unison-data _ _ (list x (unison-data _ _ (list y _)))) + (cons x y)] + [else + (raise "unison-pair->cons: unexpected value")])) + (define (hash-string hs) (string-append "#" diff --git a/scheme-libs/racket/unison/io-handles.rkt b/scheme-libs/racket/unison/io-handles.rkt index 9f5c1bdc6f..575d247163 100644 --- a/scheme-libs/racket/unison/io-handles.rkt +++ b/scheme-libs/racket/unison/io-handles.rkt @@ -3,7 +3,7 @@ rnrs/io/ports-6 (only-in rnrs standard-error-port standard-input-port standard-output-port vector-map) (only-in racket empty? with-output-to-string system/exit-code system false?) - (only-in unison/boot data-case define-unison) + (only-in unison/boot data-case define-unison-builtin) unison/data unison/chunked-seq unison/data @@ -15,26 +15,39 @@ (provide unison-FOp-IO.stdHandle unison-FOp-IO.openFile.impl.v3 - (prefix-out - builtin-IO. - (combine-out - seekHandle.impl.v3 - getLine.impl.v1 - getSomeBytes.impl.v1 - getBuffering.impl.v3 - setBuffering.impl.v3 - getEcho.impl.v1 - setEcho.impl.v1 - getArgs.impl.v1 - getEnv.impl.v1 - getChar.impl.v1 - isFileOpen.impl.v3 - isSeekable.impl.v3 - handlePosition.impl.v3 - process.call - getCurrentDirectory.impl.v3 - ready.impl.v1 - )) + + builtin-IO.seekHandle.impl.v3 + builtin-IO.seekHandle.impl.v3:termlink + builtin-IO.getLine.impl.v1 + builtin-IO.getLine.impl.v1:termlink + builtin-IO.getSomeBytes.impl.v1 + builtin-IO.getSomeBytes.impl.v1:termlink + builtin-IO.getBuffering.impl.v3 + builtin-IO.getBuffering.impl.v3:termlink + builtin-IO.setBuffering.impl.v3 + builtin-IO.setBuffering.impl.v3:termlink + builtin-IO.getEcho.impl.v1 + builtin-IO.getEcho.impl.v1:termlink + builtin-IO.setEcho.impl.v1 + builtin-IO.setEcho.impl.v1:termlink + builtin-IO.getArgs.impl.v1 + builtin-IO.getArgs.impl.v1:termlink + builtin-IO.getEnv.impl.v1 + builtin-IO.getEnv.impl.v1:termlink + builtin-IO.getChar.impl.v1 + builtin-IO.getChar.impl.v1:termlink + builtin-IO.isFileOpen.impl.v3 + builtin-IO.isFileOpen.impl.v3:termlink + builtin-IO.isSeekable.impl.v3 + builtin-IO.isSeekable.impl.v3:termlink + builtin-IO.handlePosition.impl.v3 + builtin-IO.handlePosition.impl.v3:termlink + builtin-IO.process.call + builtin-IO.process.call:termlink + builtin-IO.getCurrentDirectory.impl.v3 + builtin-IO.getCurrentDirectory.impl.v3:termlink + builtin-IO.ready.impl.v1 + builtin-IO.ready.impl.v1:termlink ; Still to implement: ; handlePosition.impl.v3 @@ -49,28 +62,34 @@ [f (ref-failure-failure typeLink msg a)]) (ref-either-left f))) -(define-unison (isFileOpen.impl.v3 port) +(define-unison-builtin + (builtin-IO.isFileOpen.impl.v3 port) (ref-either-right (not (port-closed? port)))) -(define-unison (ready.impl.v1 port) +(define-unison-builtin + (builtin-IO.ready.impl.v1 port) (if (byte-ready? port) (ref-either-right #t) (if (port-eof? port) (Exception ref-iofailure:typelink "EOF" port) (ref-either-right #f)))) -(define-unison (getCurrentDirectory.impl.v3 unit) +(define-unison-builtin + (builtin-IO.getCurrentDirectory.impl.v3 unit) (ref-either-right (string->chunked-string (path->string (current-directory))))) -(define-unison (isSeekable.impl.v3 handle) +(define-unison-builtin + (builtin-IO.isSeekable.impl.v3 handle) (ref-either-right (port-has-set-port-position!? handle))) -(define-unison (handlePosition.impl.v3 handle) +(define-unison-builtin + (builtin-IO.handlePosition.impl.v3 handle) (ref-either-right (port-position handle))) -(define-unison (seekHandle.impl.v3 handle mode amount) +(define-unison-builtin + (builtin-IO.seekHandle.impl.v3 handle mode amount) (data-case mode (0 () (set-port-position! handle amount) @@ -85,14 +104,16 @@ "SeekFromEnd not supported" 0)))) -(define-unison (getLine.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getLine.impl.v1 handle) (let* ([line (read-line handle)]) (if (eof-object? line) (ref-either-right (string->chunked-string "")) (ref-either-right (string->chunked-string line)) ))) -(define-unison (getChar.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getChar.impl.v1 handle) (let* ([char (read-char handle)]) (if (eof-object? char) (Exception @@ -101,7 +122,8 @@ ref-unit-unit) (ref-either-right char)))) -(define-unison (getSomeBytes.impl.v1 handle nbytes) +(define-unison-builtin + (builtin-IO.getSomeBytes.impl.v1 handle nbytes) (let* ([buffer (make-bytes nbytes)] [line (read-bytes-avail! buffer handle)]) (cond @@ -119,7 +141,8 @@ (subbytes buffer 0 line) buffer)))]))) -(define-unison (getBuffering.impl.v3 handle) +(define-unison-builtin + (builtin-IO.getBuffering.impl.v3 handle) (case (file-stream-buffer-mode handle) [(none) (ref-either-right ref-buffermode-no-buffering)] [(line) (ref-either-right @@ -135,7 +158,8 @@ "Unexpected response from file-stream-buffer-mode" ref-unit-unit)])) -(define-unison (setBuffering.impl.v3 handle mode) +(define-unison-builtin + (builtin-IO.setBuffering.impl.v3 handle mode) (data-case mode (0 () (file-stream-buffer-mode handle 'none) @@ -166,7 +190,8 @@ [(1) stdout] [(2) stderr])) -(define-unison (getEcho.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getEcho.impl.v1 handle) (if (eq? handle stdin) (ref-either-right (get-stdin-echo)) (Exception @@ -174,7 +199,8 @@ "getEcho only supported on stdin" ref-unit-unit))) -(define-unison (setEcho.impl.v1 handle echo) +(define-unison-builtin + (builtin-IO.setEcho.impl.v1 handle echo) (if (eq? handle stdin) (begin (if echo @@ -190,12 +216,14 @@ (let ([current (with-output-to-string (lambda () (system "stty -a")))]) (string-contains? current " echo "))) -(define-unison (getArgs.impl.v1 unit) +(define-unison-builtin + (builtin-IO.getArgs.impl.v1 unit) (ref-either-right (vector->chunked-list (vector-map string->chunked-string (current-command-line-arguments))))) -(define-unison (getEnv.impl.v1 key) +(define-unison-builtin + (builtin-IO.getEnv.impl.v1 key) (let ([value (environment-variables-ref (current-environment-variables) (string->bytes/utf-8 (chunked-string->string key)))]) (if (false? value) (Exception @@ -224,7 +252,8 @@ s) "''")) -(define-unison (process.call command arguments) +(define-unison-builtin + (builtin-IO.process.call command arguments) (system/exit-code (string-join (cons (chunked-string->string command) diff --git a/scheme-libs/racket/unison/io.rkt b/scheme-libs/racket/unison/io.rkt index bc94c53149..ae99bd1978 100644 --- a/scheme-libs/racket/unison/io.rkt +++ b/scheme-libs/racket/unison/io.rkt @@ -9,7 +9,7 @@ date-dst? date-time-zone-offset date*-time-zone-name) - (only-in unison/boot data-case define-unison) + (only-in unison/boot data-case define-unison-builtin) (only-in rnrs/arithmetic/flonums-6 flmod)) @@ -33,20 +33,29 @@ getTempDirectory.impl.v3 removeFile.impl.v3 getFileSize.impl.v3)) - (prefix-out - builtin-IO. - (combine-out - fileExists.impl.v3 - renameFile.impl.v3 - createDirectory.impl.v3 - removeDirectory.impl.v3 - directoryContents.impl.v3 - setCurrentDirectory.impl.v3 - renameDirectory.impl.v3 - isDirectory.impl.v3 - systemTime.impl.v3 - systemTimeMicroseconds.impl.v3 - createTempDirectory.impl.v3))) + + builtin-IO.fileExists.impl.v3 + builtin-IO.fileExists.impl.v3:termlink + builtin-IO.renameFile.impl.v3 + builtin-IO.renameFile.impl.v3:termlink + builtin-IO.createDirectory.impl.v3 + builtin-IO.createDirectory.impl.v3:termlink + builtin-IO.removeDirectory.impl.v3 + builtin-IO.removeDirectory.impl.v3:termlink + builtin-IO.directoryContents.impl.v3 + builtin-IO.directoryContents.impl.v3:termlink + builtin-IO.setCurrentDirectory.impl.v3 + builtin-IO.setCurrentDirectory.impl.v3:termlink + builtin-IO.renameDirectory.impl.v3 + builtin-IO.renameDirectory.impl.v3:termlink + builtin-IO.isDirectory.impl.v3 + builtin-IO.isDirectory.impl.v3:termlink + builtin-IO.systemTime.impl.v3 + builtin-IO.systemTime.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.impl.v3 + builtin-IO.systemTimeMicroseconds.impl.v3:termlink + builtin-IO.createTempDirectory.impl.v3 + builtin-IO.createTempDirectory.impl.v3:termlink) (define (failure-result ty msg vl) (ref-either-left @@ -76,7 +85,8 @@ (right (file-or-directory-modify-seconds (chunked-string->string path))))) ; in haskell, it's not just file but also directory -(define-unison (fileExists.impl.v3 path) +(define-unison-builtin + (builtin-IO.fileExists.impl.v3 path) (let ([path-string (chunked-string->string path)]) (ref-either-right (or @@ -90,11 +100,13 @@ (define (getTempDirectory.impl.v3) (right (string->chunked-string (path->string (find-system-path 'temp-dir))))) -(define-unison (setCurrentDirectory.impl.v3 path) +(define-unison-builtin + (builtin-IO.setCurrentDirectory.impl.v3 path) (current-directory (chunked-string->string path)) (ref-either-right none)) -(define-unison (directoryContents.impl.v3 path) +(define-unison-builtin + (builtin-IO.directoryContents.impl.v3 path) (with-handlers [[exn:fail:filesystem? (lambda (e) @@ -112,7 +124,8 @@ (list* "." ".." dirss)))))))) -(define-unison (createTempDirectory.impl.v3 prefix) +(define-unison-builtin + (builtin-IO.createTempDirectory.impl.v3 prefix) (ref-either-right (string->chunked-string (path->string @@ -120,35 +133,43 @@ (string->bytes/utf-8 (chunked-string->string prefix)) #""))))) -(define-unison (createDirectory.impl.v3 file) +(define-unison-builtin + (builtin-IO.createDirectory.impl.v3 file) (make-directory (chunked-string->string file)) (ref-either-right none)) -(define-unison (removeDirectory.impl.v3 file) +(define-unison-builtin + (builtin-IO.removeDirectory.impl.v3 file) (delete-directory/files (chunked-string->string file)) (ref-either-right none)) -(define-unison (isDirectory.impl.v3 path) +(define-unison-builtin + (builtin-IO.isDirectory.impl.v3 path) (ref-either-right (directory-exists? (chunked-string->string path)))) -(define-unison (renameDirectory.impl.v3 old new) +(define-unison-builtin + (builtin-IO.renameDirectory.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) (ref-either-right none)) -(define-unison (renameFile.impl.v3 old new) +(define-unison-builtin + (builtin-IO.renameFile.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) (ref-either-right none)) -(define-unison (systemTime.impl.v3 unit) +(define-unison-builtin + (builtin-IO.systemTime.impl.v3 unit) (ref-either-right (current-seconds))) -(define-unison (systemTimeMicroseconds.impl.v3 unit) +(define-unison-builtin + (builtin-IO.systemTimeMicroseconds.impl.v3 unit) (ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) -(define-unison (builtin-Clock.internals.systemTimeZone.v1 secs) +(define-unison-builtin + (builtin-Clock.internals.systemTimeZone.v1 secs) (let* ([d (seconds->date secs)]) (list->unison-tuple (list diff --git a/scheme-libs/racket/unison/math.rkt b/scheme-libs/racket/unison/math.rkt index 2e34a49987..654ac6944d 100644 --- a/scheme-libs/racket/unison/math.rkt +++ b/scheme-libs/racket/unison/math.rkt @@ -7,24 +7,39 @@ clamp-integer clamp-natural data-case - define-unison + define-unison-builtin nbit63)) (provide - builtin-Float.exp - builtin-Float.log - builtin-Float.max - builtin-Float.min - builtin-Float.tan - builtin-Float.tanh - builtin-Float.logBase - builtin-Int.* - builtin-Int.pow - builtin-Int.trailingZeros - builtin-Nat.trailingZeros - builtin-Int.popCount - builtin-Nat.popCount - builtin-Float.pow + builtin-Float.exp + builtin-Float.exp:termlink + builtin-Float.log + builtin-Float.log:termlink + builtin-Float.max + builtin-Float.max:termlink + builtin-Float.min + builtin-Float.min:termlink + builtin-Float.tan + builtin-Float.tan:termlink + builtin-Float.tanh + builtin-Float.tanh:termlink + builtin-Float.logBase + builtin-Float.logBase:termlink + builtin-Int.* + builtin-Int.*:termlink + builtin-Int.pow + builtin-Int.pow:termlink + builtin-Int.trailingZeros + builtin-Int.trailingZeros:termlink + builtin-Nat.trailingZeros + builtin-Nat.trailingZeros:termlink + builtin-Int.popCount + builtin-Int.popCount:termlink + builtin-Nat.popCount + builtin-Nat.popCount:termlink + builtin-Float.pow + builtin-Float.pow:termlink + (prefix-out unison-POp- (combine-out ABSF @@ -71,21 +86,50 @@ SINF ITOF))) -(define-unison (builtin-Float.logBase base num) (log num base)) +(define-unison-builtin + (builtin-Float.logBase base num) + (log num base)) (define (LOGB base num) (log num base)) -(define-unison (builtin-Float.exp n) (exp n)) -(define-unison (builtin-Float.log n) (log n)) -(define-unison (builtin-Float.max n m) (max n m)) -(define-unison (builtin-Float.min n m) (min n m)) -(define-unison (builtin-Float.tan n) (tan n)) -(define-unison (builtin-Float.tanh n) (tanh n)) -(define-unison (builtin-Int.* n m) (clamp-integer (* n m))) -(define-unison (builtin-Int.pow n m) (clamp-integer (expt n m))) -(define-unison (builtin-Int.trailingZeros n) (TZRO n)) -(define-unison (builtin-Nat.trailingZeros n) (TZRO n)) -(define-unison (builtin-Nat.popCount n) (POPC n)) -(define-unison (builtin-Int.popCount n) (POPC n)) -(define-unison (builtin-Float.pow n m) (expt n m)) + +(define-unison-builtin + (builtin-Float.exp n) (exp n)) + +(define-unison-builtin + (builtin-Float.log n) (log n)) + +(define-unison-builtin + (builtin-Float.max n m) (max n m)) + +(define-unison-builtin + (builtin-Float.min n m) (min n m)) + +(define-unison-builtin + (builtin-Float.tan n) (tan n)) + +(define-unison-builtin + (builtin-Float.tanh n) (tanh n)) + +(define-unison-builtin + (builtin-Int.* n m) (clamp-integer (* n m))) + +(define-unison-builtin + (builtin-Int.pow n m) (clamp-integer (expt n m))) + +(define-unison-builtin + (builtin-Int.trailingZeros n) (TZRO n)) + +(define-unison-builtin + (builtin-Nat.trailingZeros n) (TZRO n)) + +(define-unison-builtin + (builtin-Nat.popCount n) (POPC n)) + +(define-unison-builtin + (builtin-Int.popCount n) (POPC n)) + +(define-unison-builtin + (builtin-Float.pow n m) (expt n m)) + (define (EXPF n) (exp n)) (define ABSF abs) (define ACOS acos) diff --git a/scheme-libs/racket/unison/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 0e9b462ff6..105d3ec205 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -31,9 +31,11 @@ builtin-sandboxLinks builtin-sandboxLinks:termlink + builtin-Code.dependencies:termlink builtin-Code.deserialize:termlink builtin-Code.serialize:termlink builtin-Code.validateLinks:termlink + builtin-Value.dependencies:termlink builtin-Value.deserialize:termlink builtin-Value.serialize:termlink builtin-crypto.hash:termlink @@ -54,21 +56,15 @@ build-runtime-module termlink->proc) -(define-builtin-link Value.value) -(define-builtin-link Value.reflect) -(define-builtin-link Code.isMissing) -(define-builtin-link Code.lookup) - +(define-builtin-link Code.dependencies) (define-builtin-link Code.deserialize) (define-builtin-link Code.serialize) (define-builtin-link Code.validateLinks) +(define-builtin-link Value.dependencies) (define-builtin-link Value.deserialize) (define-builtin-link Value.serialize) (define-builtin-link crypto.hash) (define-builtin-link crypto.hmac) -(define-builtin-link validateSandboxed) -(define-builtin-link Value.validateSandboxed) -(define-builtin-link sandboxLinks) (define (chunked-list->list cl) (vector->list (chunked-list->vector cl))) @@ -129,14 +125,33 @@ (raise (format "decode-binding: unimplemented case: ~a" bn))])) +(define (decode-hints hs) + (define (hint->sym t) + (cond + [(= t ref-defnhint-internal:tag) 'internal] + [(= t ref-defnhint-genlink:tag) 'gen-link] + [(= t ref-defnhint-nolinkdecl:tag) 'no-link-decl])) + + (for/fold ([def 'define-unison] [out '()]) ([h hs]) + (match h + [(unison-data _ t (list)) + #:when (= t ref-defnhint-builtin:tag) + (values 'define-unison-builtin out)] + [(unison-data _ t (list)) + (values def (cons (hint->sym t) out))]))) + (define (decode-syntax dfn) (match dfn - [(unison-data _ t (list nm vs bd)) + [(unison-data _ t (list nm hs vs bd)) #:when (= t ref-schemedefn-define:tag) - (let ([head (map text->ident - (cons nm (chunked-list->list vs)))] - [body (decode-term bd)]) - (list 'define-unison head body))] + (let-values + ([(head) (map text->ident + (cons nm (chunked-list->list vs)))] + [(def hints) (decode-hints (chunked-list->list hs))] + [(body) (decode-term bd)]) + (if (null? hints) + (list def head body) + (list def '#:hints hints head body)))] [(unison-data _ t (list nm bd)) #:when (= t ref-schemedefn-alias:tag) (list 'define (text->ident nm) (decode-term bd))] @@ -195,20 +210,17 @@ (describe-value tl)))] [1 (rf) rf])) -(define-syntax make-group-ref-decoder - (lambda (stx) - (syntax-case stx () - [(_) - #`(lambda (gr) - (data-case (group-ref-ident gr) - [#,ref-schemeterm-ident:tag (name) name] - [else - (raise - (format - "decode-group-ref: unimplemented data case: ~a" - (describe-value gr)))]))]))) - -(define decode-group-ref (make-group-ref-decoder)) +(define (decode-group-ref gr0) + (match (group-ref-ident gr0) + [(unison-data _ t (list name)) + #:when (= t ref-schemeterm-ident:tag) + name] + [else + (raise + (format + "decode-group-ref: unimplemented data case: ~a" + (describe-value gr0)))])) + (define (group-ref-sym gr) (string->symbol (chunked-string->string @@ -301,6 +313,70 @@ [else (raise (format "decode-vlit: unimplemented case: !a" vl))])])) +(define (reify-handlers hs) + (for/list ([h (chunked-list->list hs)]) + (match (unison-pair->cons h) + [(cons r h) + (cons (reference->typelink r) + (reify-value h))]))) + +(define (reflect-handlers hs) + (list->chunked-list + (for/list ([h hs]) + (match h + [(cons r h) + (unison-tuple + (typelink->reference r) + (reflect-value h))])))) + +(define (reify-groupref gr0) + (match gr0 + [(unison-data _ t (list r i)) + #:when (= t ref-groupref-group:tag) + (cons (reference->typelink r) i)])) + +(define (reflect-groupref rt) + (match rt + [(cons l i) + (ref-groupref-group (typelink->reference l) i)])) + +(define (parse-continuation orig k0 vs0) + (let rec ([k k0] [vs vs0] [frames '()]) + (match k + [(unison-data _ t (list)) + #:when (= t ref-cont-empty:tag) + (unison-cont-reflected (reverse frames))] + [(unison-data _ t (list l a gr0 k)) + #:when (= t ref-cont-push:tag) + (cond + [(>= (length vs) (+ l a)) + (let*-values + ([(locals int) (split-at vs l)] + [(args rest) (split-at int a)] + [(gr) (reify-groupref gr0)] + [(fm) (unison-frame-push locals args gr)]) + (rec k rest (cons fm frames)))] + [else + (raise + (make-exn:bug + "reify-value: malformed continuation" + orig))])] + [(unison-data _ t (list a rs0 de0 k)) + #:when (= t ref-cont-mark:tag) + (cond + [(>= (length vs) a) + (let*-values + ([(args rest) (split-at vs a)] + [(rs) (map reference->termlink (chunked-list->list rs0))] + [(hs) (reify-handlers de0)] + [(fm) (unison-frame-mark args rs hs)]) + (rec k rest (cons fm frames)))] + [else + (raise + (make-exn:bug + "reify-value: malformed continuation" + orig))])]))) + (define (reify-value v) (match v [(unison-data _ t (list rf rt bs0)) @@ -327,16 +403,14 @@ #:when (= t ref-value-partial:tag) (let ([bs (map reify-value (chunked-list->list bs0))] [proc (resolve-proc gr)]) - (apply proc bs))] + (struct-copy unison-closure proc [env bs]))] [(unison-data _ t (list vl)) #:when (= t ref-value-vlit:tag) (reify-vlit vl)] - [(unison-data _ t (list bs0 k)) + [(unison-data _ t (list vs0 k)) #:when (= t ref-value-cont:tag) - (raise - (make-exn:bug - "reify-value: unimplemented cont case" - ref-unit-unit))] + (parse-continuation v k + (map reify-value (chunked-list->list vs0)))] [(unison-data r t fs) (raise (make-exn:bug @@ -413,14 +487,34 @@ (ref-value-vlit (ref-vlit-typelink (reflect-typelink v)))] [(unison-code sg) (ref-value-vlit (ref-vlit-code sg))] [(unison-quote q) (ref-value-vlit (ref-vlit-quote q))] - [(unison-closure f as) + [(unison-cont-reflected frames0) + (for/foldr ([k ref-cont-empty] + [vs '()] + #:result + (ref-value-cont + (list->chunked-list (map reflect-value vs)) + k)) + ([frame frames0]) + (match frame + [(unison-frame-push locals args return-to) + (values + (ref-cont-push + (length locals) + (length args) + (reflect-groupref return-to) + k) + (append locals args vs))] + [(unison-frame-mark args refs hs) + (values + (ref-cont-mark + (length args) + (map typelink->reference refs) + (reflect-handlers hs)) + (append args vs))]))] + [(unison-closure arity f as) (ref-value-partial (function->groupref f) (list->chunked-list (map reflect-value as)))] - [(? procedure?) - (ref-value-partial - (function->groupref v) - empty-chunked-list)] [(unison-data rf t fs) (ref-value-data (reflect-typelink rf) @@ -438,7 +532,7 @@ [(? chunked-list?) (for/fold ([acc '()]) ([e (in-chunked-list v)]) (append (sandbox-value ok e) acc))] - [(unison-closure f as) + [(unison-closure arity f as) (for/fold ([acc (sandbox-proc ok f)]) ([a (in-list as)]) (append (sandbox-scheme-value ok a) acc))] [(? procedure?) (sandbox-proc ok v)] @@ -474,11 +568,11 @@ [(unison-quote v) (sandbox-value ok v)])) ; replacment for Value.unsafeValue : a -> Value -(define-unison +(define-unison-builtin (builtin-Value.reflect v) (reflect-value v)) -(define-unison +(define-unison-builtin (builtin-Value.value v) (let ([rv (reflect-value v)]) (unison-quote rv))) @@ -706,23 +800,23 @@ (define (unison-POp-LKUP tl) (lookup-code tl)) -(define-unison (builtin-Code.lookup tl) +(define-unison-builtin (builtin-Code.lookup tl) (match (lookup-code tl) [(unison-sum 0 (list)) ref-optional-none] [(unison-sum 1 (list co)) (ref-optional-some co)])) -(define-unison (builtin-validateSandboxed ok v) +(define-unison-builtin (builtin-validateSandboxed ok v) (let ([l (sandbox-scheme-value (chunked-list->list ok) v)]) (null? l))) -(define-unison (builtin-sandboxLinks tl) (check-sandbox tl)) +(define-unison-builtin (builtin-sandboxLinks tl) (check-sandbox tl)) -(define-unison (builtin-Code.isMissing tl) +(define-unison-builtin (builtin-Code.isMissing tl) (cond [(unison-termlink-builtin? tl) #f] [(unison-termlink-con? tl) #f] [(have-code? tl) #t] [else #f])) -(define-unison (builtin-Value.validateSandboxed ok v) +(define-unison-builtin (builtin-Value.validateSandboxed ok v) (sandbox-quoted (chunked-list->list ok) v)) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 225b68acdb..712727499f 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -21,1499 +21,1476 @@ ; Unison.Runtime.Builtin, so the POp/FOp implementation must ; take/return arguments that match what is expected in those wrappers. -#!r6rs -(library (unison primops) - (export - builtin-Float.* - builtin-Float.*:termlink - builtin-Float.>= - builtin-Float.>=:termlink - builtin-Float.<= - builtin-Float.<=:termlink - builtin-Float.> - builtin-Float.>:termlink - builtin-Float.< - builtin-Float.<:termlink - builtin-Float.== - builtin-Float.==:termlink - builtin-Float.fromRepresentation - builtin-Float.fromRepresentation:termlink - builtin-Float.toRepresentation - builtin-Float.toRepresentation:termlink - builtin-Float.ceiling - builtin-Float.ceiling:termlink - builtin-Float.exp - builtin-Float.exp:termlink - builtin-Float.log - builtin-Float.log:termlink - builtin-Float.max - builtin-Float.max:termlink - builtin-Float.min - builtin-Float.min:termlink - builtin-Float.tan - builtin-Float.tan:termlink - builtin-Float.tanh - builtin-Float.tanh:termlink - builtin-Float.logBase - builtin-Float.logBase:termlink - builtin-Float.pow - builtin-Float.pow:termlink - builtin-Int.pow - builtin-Int.pow:termlink - builtin-Int.* - builtin-Int.*:termlink - builtin-Int.+ - builtin-Int.+:termlink - builtin-Int.- - builtin-Int.-:termlink - builtin-Int./ - builtin-Int./:termlink - builtin-Int.increment - builtin-Int.increment:termlink - builtin-Int.negate - builtin-Int.negate:termlink - builtin-Int.fromRepresentation - builtin-Int.fromRepresentation:termlink - builtin-Int.toRepresentation - builtin-Int.toRepresentation:termlink - builtin-Int.signum - builtin-Int.signum:termlink - builtin-Int.trailingZeros - builtin-Int.trailingZeros:termlink - builtin-Int.popCount - builtin-Int.popCount:termlink - builtin-Int.isEven - builtin-Int.isEven:termlink - builtin-Int.isOdd - builtin-Int.isOdd:termlink - builtin-Int.== - builtin-Int.==:termlink - builtin-Int.< - builtin-Int.<:termlink - builtin-Int.<= - builtin-Int.<=:termlink - builtin-Int.> - builtin-Int.>:termlink - builtin-Int.>= - builtin-Int.>=:termlink - builtin-Nat.+ - builtin-Nat.+:termlink - builtin-Nat.drop - builtin-Nat.drop:termlink - builtin-Nat.== - builtin-Nat.==:termlink - builtin-Nat.< - builtin-Nat.<:termlink - builtin-Nat.<= - builtin-Nat.<=:termlink - builtin-Nat.> - builtin-Nat.>:termlink - builtin-Nat.>= - builtin-Nat.>=:termlink - builtin-Nat.isEven - builtin-Nat.isEven:termlink - builtin-Nat.isOdd - builtin-Nat.isOdd:termlink - builtin-Nat.increment - builtin-Nat.increment:termlink - builtin-Nat.popCount - builtin-Nat.popCount:termlink - builtin-Nat.toFloat - builtin-Nat.toFloat:termlink - builtin-Nat.trailingZeros - builtin-Nat.trailingZeros:termlink - builtin-Text.indexOf - builtin-Text.indexOf:termlink - builtin-Text.== - builtin-Text.==:termlink - builtin-Text.!= - builtin-Text.!=:termlink - builtin-Text.<= - builtin-Text.<=:termlink - builtin-Text.>= - builtin-Text.>=:termlink - builtin-Text.< - builtin-Text.<:termlink - builtin-Text.> - builtin-Text.>:termlink - builtin-Bytes.indexOf - builtin-Bytes.indexOf:termlink - builtin-IO.randomBytes - builtin-IO.randomBytes:termlink - builtin-IO.tryEval - builtin-IO.tryEval:termlink - - builtin-Scope.bytearrayOf - builtin-Scope.bytearrayOf:termlink - - builtin-Universal.== - builtin-Universal.==:termlink - builtin-Universal.> - builtin-Universal.>:termlink - builtin-Universal.>= - builtin-Universal.>=:termlink - builtin-Universal.< - builtin-Universal.<:termlink - builtin-Universal.<= - builtin-Universal.<=:termlink - builtin-Universal.compare - builtin-Universal.compare:termlink - builtin-Universal.murmurHash:termlink - - builtin-unsafe.coerceAbilities - builtin-unsafe.coerceAbilities:termlink - - builtin-List.splitLeft - builtin-List.splitLeft:termlink - builtin-List.splitRight - builtin-List.splitRight:termlink - - builtin-Link.Term.toText - builtin-Link.Term.toText:termlink - - builtin-Value.toBuiltin - builtin-Value.toBuiltin:termlink - builtin-Value.fromBuiltin - builtin-Value.fromBuiltin:termlink - builtin-Code.fromGroup - builtin-Code.fromGroup:termlink - builtin-Code.toGroup - builtin-Code.toGroup:termlink - builtin-TermLink.fromReferent - builtin-TermLink.fromReferent:termlink - builtin-TermLink.toReferent - builtin-TermLink.toReferent:termlink - builtin-TypeLink.toReference - builtin-TypeLink.toReference:termlink - - builtin-IO.UDP.clientSocket.impl.v1 - builtin-IO.UDP.clientSocket.impl.v1:termlink - builtin-IO.UDP.UDPSocket.recv.impl.v1 - builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink - builtin-IO.UDP.UDPSocket.send.impl.v1 - builtin-IO.UDP.UDPSocket.send.impl.v1:termlink - builtin-IO.UDP.UDPSocket.close.impl.v1 - builtin-IO.UDP.UDPSocket.close.impl.v1:termlink - builtin-IO.UDP.ListenSocket.close.impl.v1 - builtin-IO.UDP.ListenSocket.close.impl.v1:termlink - builtin-IO.UDP.UDPSocket.toText.impl.v1 - builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink - builtin-IO.UDP.serverSocket.impl.v1 - builtin-IO.UDP.serverSocket.impl.v1:termlink - builtin-IO.UDP.ListenSocket.toText.impl.v1 - builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink - builtin-IO.UDP.ClientSockAddr.toText.v1 - builtin-IO.UDP.ClientSockAddr.toText.v1:termlink - builtin-IO.UDP.ListenSocket.sendTo.impl.v1 - builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink - - unison-FOp-internal.dataTag - unison-FOp-Char.toText - ; unison-FOp-Code.dependencies - ; unison-FOp-Code.serialize - unison-FOp-IO.closeFile.impl.v3 - unison-FOp-IO.openFile.impl.v3 - ; unison-FOp-IO.isFileEOF.impl.v3 - unison-FOp-IO.putBytes.impl.v3 - unison-FOp-IO.getBytes.impl.v3 - builtin-IO.seekHandle.impl.v3 - builtin-IO.seekHandle.impl.v3:termlink - builtin-IO.getLine.impl.v1 - builtin-IO.getLine.impl.v1:termlink - builtin-IO.getSomeBytes.impl.v1 - builtin-IO.getSomeBytes.impl.v1:termlink - builtin-IO.setBuffering.impl.v3 - builtin-IO.setBuffering.impl.v3:termlink - builtin-IO.getBuffering.impl.v3 - builtin-IO.getBuffering.impl.v3:termlink - builtin-IO.setEcho.impl.v1 - builtin-IO.setEcho.impl.v1:termlink - builtin-IO.isFileOpen.impl.v3 - builtin-IO.isFileOpen.impl.v3:termlink - builtin-IO.ready.impl.v1 - builtin-IO.ready.impl.v1:termlink - builtin-IO.process.call - builtin-IO.process.call:termlink - builtin-IO.getEcho.impl.v1 - builtin-IO.getEcho.impl.v1:termlink - builtin-IO.getArgs.impl.v1 - builtin-IO.getArgs.impl.v1:termlink - builtin-IO.getEnv.impl.v1 - builtin-IO.getEnv.impl.v1:termlink - builtin-IO.getChar.impl.v1 - builtin-IO.getChar.impl.v1:termlink - builtin-IO.getCurrentDirectory.impl.v3 - builtin-IO.getCurrentDirectory.impl.v3:termlink - builtin-IO.removeDirectory.impl.v3 - builtin-IO.removeDirectory.impl.v3:termlink - builtin-IO.renameFile.impl.v3 - builtin-IO.renameFile.impl.v3:termlink - builtin-IO.createTempDirectory.impl.v3 - builtin-IO.createTempDirectory.impl.v3:termlink - builtin-IO.createDirectory.impl.v3 - builtin-IO.createDirectory.impl.v3:termlink - builtin-IO.setCurrentDirectory.impl.v3 - builtin-IO.setCurrentDirectory.impl.v3:termlink - builtin-IO.renameDirectory.impl.v3 - builtin-IO.renameDirectory.impl.v3:termlink - builtin-IO.isDirectory.impl.v3 - builtin-IO.isDirectory.impl.v3:termlink - builtin-IO.isSeekable.impl.v3 - builtin-IO.isSeekable.impl.v3:termlink - builtin-IO.handlePosition.impl.v3 - builtin-IO.handlePosition.impl.v3:termlink - builtin-IO.systemTime.impl.v3 - builtin-IO.systemTime.impl.v3:termlink - builtin-IO.systemTimeMicroseconds.impl.v3 - builtin-IO.systemTimeMicroseconds.impl.v3:termlink - - builtin-Char.Class.is - builtin-Char.Class.is:termlink - builtin-Pattern.captureAs - builtin-Pattern.captureAs:termlink - builtin-Pattern.many.corrected - builtin-Pattern.many.corrected:termlink - builtin-Pattern.isMatch - builtin-Pattern.isMatch:termlink - builtin-IO.fileExists.impl.v3 - builtin-IO.fileExists.impl.v3:termlink - builtin-IO.isFileEOF.impl.v3 - builtin-IO.isFileEOF.impl.v3:termlink - - unison-FOp-IO.getFileSize.impl.v3 - unison-FOp-IO.getFileTimestamp.impl.v3 - ; unison-FOp-IO.fileExists.impl.v3 - unison-FOp-IO.removeFile.impl.v3 - unison-FOp-IO.getTempDirectory.impl.v3 - unison-FOp-Text.fromUtf8.impl.v3 - unison-FOp-Text.repeat - unison-FOp-Text.reverse - unison-FOp-Text.toUtf8 - unison-FOp-Text.toLowercase - unison-FOp-Text.toUppercase - unison-FOp-Pattern.run - unison-FOp-Pattern.isMatch - unison-FOp-Pattern.many - unison-FOp-Pattern.capture - unison-FOp-Pattern.join - unison-FOp-Pattern.or - unison-FOp-Pattern.replicate - unison-FOp-Text.patterns.digit - unison-FOp-Text.patterns.letter - unison-FOp-Text.patterns.punctuation - unison-FOp-Text.patterns.charIn - unison-FOp-Text.patterns.notCharIn - unison-FOp-Text.patterns.anyChar - unison-FOp-Text.patterns.space - unison-FOp-Text.patterns.charRange - unison-FOp-Text.patterns.notCharRange - unison-FOp-Text.patterns.literal - unison-FOp-Text.patterns.eof - unison-FOp-Text.patterns.char - unison-FOp-Char.Class.is - unison-FOp-Char.Class.any - unison-FOp-Char.Class.alphanumeric - unison-FOp-Char.Class.upper - unison-FOp-Char.Class.lower - unison-FOp-Char.Class.number - unison-FOp-Char.Class.punctuation - unison-FOp-Char.Class.symbol - unison-FOp-Char.Class.letter - unison-FOp-Char.Class.whitespace - unison-FOp-Char.Class.control - unison-FOp-Char.Class.printable - unison-FOp-Char.Class.mark - unison-FOp-Char.Class.separator - unison-FOp-Char.Class.or - unison-FOp-Char.Class.range - unison-FOp-Char.Class.anyOf - unison-FOp-Char.Class.and - unison-FOp-Char.Class.not - unison-FOp-Clock.internals.nsec.v1 - unison-FOp-Clock.internals.sec.v1 - unison-FOp-Clock.internals.threadCPUTime.v1 - unison-FOp-Clock.internals.processCPUTime.v1 - unison-FOp-Clock.internals.realtime.v1 - unison-FOp-Clock.internals.monotonic.v1 - builtin-Clock.internals.systemTimeZone.v1 - builtin-Clock.internals.systemTimeZone.v1:termlink - - - ; unison-FOp-Value.serialize - unison-FOp-IO.stdHandle - unison-FOp-IO.getArgs.impl.v1 - - builtin-IO.directoryContents.impl.v3 - builtin-IO.directoryContents.impl.v3:termlink - unison-FOp-IO.systemTimeMicroseconds.v1 - - unison-FOp-ImmutableArray.copyTo! - unison-FOp-ImmutableArray.read - - unison-FOp-MutableArray.copyTo! - unison-FOp-MutableArray.freeze! - unison-FOp-MutableArray.freeze - unison-FOp-MutableArray.read - unison-FOp-MutableArray.write - - unison-FOp-MutableArray.size - unison-FOp-ImmutableArray.size - - unison-FOp-MutableByteArray.size - unison-FOp-ImmutableByteArray.size - - unison-FOp-MutableByteArray.length - unison-FOp-ImmutableByteArray.length - - unison-FOp-ImmutableByteArray.copyTo! - unison-FOp-ImmutableByteArray.read8 - unison-FOp-ImmutableByteArray.read16be - unison-FOp-ImmutableByteArray.read24be - unison-FOp-ImmutableByteArray.read32be - unison-FOp-ImmutableByteArray.read40be - unison-FOp-ImmutableByteArray.read48be - unison-FOp-ImmutableByteArray.read56be - unison-FOp-ImmutableByteArray.read64be - - unison-FOp-MutableByteArray.copyTo! - unison-FOp-MutableByteArray.freeze! - unison-FOp-MutableByteArray.write8 - unison-FOp-MutableByteArray.write16be - unison-FOp-MutableByteArray.write32be - unison-FOp-MutableByteArray.write64be - unison-FOp-MutableByteArray.read8 - unison-FOp-MutableByteArray.read16be - unison-FOp-MutableByteArray.read24be - unison-FOp-MutableByteArray.read32be - unison-FOp-MutableByteArray.read40be - unison-FOp-MutableByteArray.read64be - - unison-FOp-Scope.bytearray - unison-FOp-Scope.bytearrayOf - unison-FOp-Scope.array - unison-FOp-Scope.arrayOf - unison-FOp-Scope.ref - - unison-FOp-IO.bytearray - unison-FOp-IO.bytearrayOf - unison-FOp-IO.array - unison-FOp-IO.arrayOf - - unison-FOp-IO.ref - unison-FOp-Ref.read - unison-FOp-Ref.write - unison-FOp-Ref.readForCas - unison-FOp-Ref.Ticket.read - unison-FOp-Ref.cas - - unison-FOp-Promise.new - unison-FOp-Promise.read - unison-FOp-Promise.tryRead - unison-FOp-Promise.write - - unison-FOp-IO.delay.impl.v3 - unison-POp-FORK - unison-FOp-IO.kill.impl.v3 - - unison-FOp-Handle.toText - unison-FOp-Socket.toText - unison-FOp-ThreadId.toText - - unison-POp-ABSF - unison-POp-ACOS - unison-POp-ACSH - unison-POp-ADDF - unison-POp-ASIN - unison-POp-ASNH - unison-POp-ATAN - unison-POp-ATN2 - unison-POp-ATNH - unison-POp-CEIL - unison-POp-FLOR - unison-POp-COSF - unison-POp-COSH - unison-POp-DIVF - unison-POp-DIVI - unison-POp-EQLF - unison-POp-EQLI - unison-POp-SUBF - unison-POp-SUBI - unison-POp-SGNI - unison-POp-LEQF - unison-POp-SINF - unison-POp-SINH - unison-POp-TRNF - unison-POp-RNDF - unison-POp-SQRT - unison-POp-TANH - unison-POp-TANF - unison-POp-TZRO - unison-POp-POPC - unison-POp-ITOF - - unison-POp-ADDN - unison-POp-ANDN - unison-POp-BLDS - unison-POp-CATS - unison-POp-CATT - unison-POp-CATB - unison-POp-CMPU - unison-POp-COMN - unison-POp-CONS - unison-POp-DBTX - unison-POp-DECI - unison-POp-INCI - unison-POp-DECN - unison-POp-INCN - unison-POp-DIVN - unison-POp-DRPB - unison-POp-DRPS - unison-POp-DRPT - unison-POp-EQLN - unison-POp-EQLT - unison-POp-EXPF - unison-POp-LEQT - unison-POp-EQLU - unison-POp-EROR - unison-POp-FTOT - unison-POp-IDXB - unison-POp-IDXS - unison-POp-IORN - unison-POp-ITOT - unison-POp-LEQN - ; unison-POp-LKUP - unison-POp-LZRO - unison-POp-MULN - unison-POp-MODN - unison-POp-NTOT - unison-POp-PAKT - unison-POp-SHLI - unison-POp-SHLN - unison-POp-SHRI - unison-POp-SHRN - unison-POp-SIZS - unison-POp-SIZT - unison-POp-SIZB - unison-POp-SNOC - unison-POp-SUBN - unison-POp-SUBI - unison-POp-TAKS - unison-POp-TAKT - unison-POp-TAKB - unison-POp-TRCE - unison-POp-PRNT - unison-POp-TTON - unison-POp-TTOI - unison-POp-TTOF - unison-POp-UPKT - unison-POp-XORN - unison-POp-VALU - unison-POp-VWLS - unison-POp-UCNS - unison-POp-USNC - unison-POp-FLTB - unison-POp-MAXF - unison-POp-MINF - unison-POp-MULF - unison-POp-MULI - unison-POp-NEGI - unison-POp-NTOF - unison-POp-POWF - unison-POp-POWI - unison-POp-POWN - - unison-POp-UPKB - unison-POp-PAKB - unison-POp-ADDI - unison-POp-MULI - unison-POp-MODI - unison-POp-LEQI - unison-POp-LOGB - unison-POp-LOGF - unison-POp-POWN - unison-POp-VWRS - unison-POp-SPLL - unison-POp-SPLR - - unison-FOp-Bytes.gzip.compress - unison-FOp-Bytes.gzip.decompress - unison-FOp-Bytes.zlib.compress - unison-FOp-Bytes.zlib.decompress - unison-FOp-Bytes.toBase16 - unison-FOp-Bytes.toBase32 - unison-FOp-Bytes.toBase64 - unison-FOp-Bytes.toBase64UrlUnpadded - unison-FOp-Bytes.fromBase16 - unison-FOp-Bytes.fromBase32 - unison-FOp-Bytes.fromBase64 - unison-FOp-Bytes.fromBase64UrlUnpadded - unison-FOp-Bytes.encodeNat16be - unison-FOp-Bytes.encodeNat16le - unison-FOp-Bytes.encodeNat32be - unison-FOp-Bytes.encodeNat32le - unison-FOp-Bytes.encodeNat64be - unison-FOp-Bytes.encodeNat64le - unison-FOp-Bytes.decodeNat16be - unison-FOp-Bytes.decodeNat16le - unison-FOp-Bytes.decodeNat32be - unison-FOp-Bytes.decodeNat32le - unison-FOp-Bytes.decodeNat64be - unison-FOp-Bytes.decodeNat64le - - unison-FOp-crypto.hashBytes - unison-FOp-crypto.hmacBytes - unison-FOp-crypto.HashAlgorithm.Md5 - unison-FOp-crypto.HashAlgorithm.Sha1 - unison-FOp-crypto.HashAlgorithm.Sha2_256 - unison-FOp-crypto.HashAlgorithm.Sha2_512 - unison-FOp-crypto.HashAlgorithm.Sha3_256 - unison-FOp-crypto.HashAlgorithm.Sha3_512 - unison-FOp-crypto.HashAlgorithm.Blake2s_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_512 - - unison-FOp-IO.clientSocket.impl.v3 - unison-FOp-IO.closeSocket.impl.v3 - unison-FOp-IO.socketReceive.impl.v3 - unison-FOp-IO.socketSend.impl.v3 - unison-FOp-IO.socketPort.impl.v3 - unison-FOp-IO.serverSocket.impl.v3 - unison-FOp-IO.socketAccept.impl.v3 - unison-FOp-IO.listen.impl.v3 - unison-FOp-Tls.ClientConfig.default - unison-FOp-Tls.ClientConfig.certificates.set - unison-FOp-Tls.decodeCert.impl.v3 - unison-FOp-Tls.encodeCert - unison-FOp-Tls.newServer.impl.v3 - unison-FOp-Tls.decodePrivateKey - unison-FOp-Tls.encodePrivateKey - unison-FOp-Tls.ServerConfig.default - unison-FOp-Tls.handshake.impl.v3 - unison-FOp-Tls.newClient.impl.v3 - unison-FOp-Tls.receive.impl.v3 - unison-FOp-Tls.send.impl.v3 - unison-FOp-Tls.terminate.impl.v3 - - ; fake builtins - builtin-murmurHashBytes) - - (import (rnrs) - (only (srfi :13) string-reverse) - (racket performance-hint) - (only (racket flonum) - fl< - fl> - fl<= - fl>= - fl=) - (rename - (only (racket) - car - cdr - exact-integer? - exact-nonnegative-integer? - foldl - integer-length - bytes->string/utf-8 - string->bytes/utf-8 - exn:fail:contract? - file-stream-buffer-mode - with-handlers - match - modulo - quotient - regexp-match-positions - sequence-ref - vector-copy! - bytes-copy! - sub1 - add1 - exn:break? - exn:fail? - exn:fail:read? - exn:fail:filesystem? - exn:fail:network? - exn:fail:contract:divide-by-zero? - exn:fail:contract:non-fixnum-result?) - (car icar) (cdr icdr)) - (only (racket string) - string-contains? - string-replace) - (unison arithmetic) - (unison bytevector) - (unison core) - (only (unison boot) - define-unison - referent->termlink - termlink->referent - typelink->reference - clamp-integer - clamp-natural - wrap-natural - exn:bug->exception - raise-unison-exception - bit64 - bit63 - nbit63) - (unison data) - (unison data-info) - (unison math) - (unison chunked-seq) - (unison chunked-bytes) - (unison string-search) - (unison bytes-nat) - (unison pattern) - (unison crypto) - (unison io) - (unison io-handles) - (unison murmurhash) - (unison tls) - (unison tcp) - (unison udp) - (unison gzip) - (unison zlib) - (unison concurrent) - (racket random)) - - (define-builtin-link Float.*) - (define-builtin-link Float.fromRepresentation) - (define-builtin-link Float.toRepresentation) - (define-builtin-link Float.ceiling) - (define-builtin-link Float.exp) - (define-builtin-link Float.log) - (define-builtin-link Float.max) - (define-builtin-link Float.min) - (define-builtin-link Float.tan) - (define-builtin-link Float.tanh) - (define-builtin-link Float.logBase) - (define-builtin-link Float.pow) - (define-builtin-link Float.>) - (define-builtin-link Float.<) - (define-builtin-link Float.>=) - (define-builtin-link Float.<=) - (define-builtin-link Float.==) - (define-builtin-link Int.pow) - (define-builtin-link Int.*) - (define-builtin-link Int.+) - (define-builtin-link Int.-) - (define-builtin-link Int./) - (define-builtin-link Int.>) - (define-builtin-link Int.<) - (define-builtin-link Int.>=) - (define-builtin-link Int.<=) - (define-builtin-link Int.==) - (define-builtin-link Int.isEven) - (define-builtin-link Int.isOdd) - (define-builtin-link Int.increment) - (define-builtin-link Int.negate) - (define-builtin-link Int.fromRepresentation) - (define-builtin-link Int.toRepresentation) - (define-builtin-link Int.signum) - (define-builtin-link Int.trailingZeros) - (define-builtin-link Int.popCount) - (define-builtin-link Nat.increment) - (define-builtin-link Nat.popCount) - (define-builtin-link Nat.toFloat) - (define-builtin-link Nat.trailingZeros) - (define-builtin-link Nat.+) - (define-builtin-link Nat.>) - (define-builtin-link Nat.<) - (define-builtin-link Nat.>=) - (define-builtin-link Nat.<=) - (define-builtin-link Nat.==) - (define-builtin-link Nat.drop) - (define-builtin-link Nat.isEven) - (define-builtin-link Nat.isOdd) - (define-builtin-link Text.indexOf) - (define-builtin-link Text.>) - (define-builtin-link Text.<) - (define-builtin-link Text.>=) - (define-builtin-link Text.<=) - (define-builtin-link Text.==) - (define-builtin-link Text.!=) - (define-builtin-link Bytes.indexOf) - (define-builtin-link IO.randomBytes) - (define-builtin-link IO.tryEval) - (define-builtin-link List.splitLeft) - (define-builtin-link List.splitRight) - (define-builtin-link Value.toBuiltin) - (define-builtin-link Value.fromBuiltin) - (define-builtin-link Code.fromGroup) - (define-builtin-link Code.toGroup) - (define-builtin-link TermLink.fromReferent) - (define-builtin-link TermLink.toReferent) - (define-builtin-link TypeLink.toReference) - (define-builtin-link IO.seekHandle.impl.v3) - (define-builtin-link IO.getLine.impl.v1) - (define-builtin-link IO.getSomeBytes.impl.v1) - (define-builtin-link IO.setBuffering.impl.v3) - (define-builtin-link IO.getBuffering.impl.v3) - (define-builtin-link IO.setEcho.impl.v1) - (define-builtin-link IO.isFileOpen.impl.v3) - (define-builtin-link IO.ready.impl.v1) - (define-builtin-link IO.process.call) - (define-builtin-link IO.getEcho.impl.v1) - (define-builtin-link IO.getArgs.impl.v1) - (define-builtin-link IO.getEnv.impl.v1) - (define-builtin-link IO.getChar.impl.v1) - (define-builtin-link IO.getCurrentDirectory.impl.v3) - (define-builtin-link IO.directoryContents.impl.v3) - (define-builtin-link IO.removeDirectory.impl.v3) - (define-builtin-link IO.renameFile.impl.v3) - (define-builtin-link IO.createTempDirectory.impl.v3) - (define-builtin-link IO.createDirectory.impl.v3) - (define-builtin-link IO.setCurrentDirectory.impl.v3) - (define-builtin-link IO.renameDirectory.impl.v3) - (define-builtin-link IO.fileExists.impl.v3) - (define-builtin-link IO.isDirectory.impl.v3) - (define-builtin-link IO.isFileEOF.impl.v3) - (define-builtin-link IO.isSeekable.impl.v3) - (define-builtin-link IO.handlePosition.impl.v3) - (define-builtin-link IO.systemTime.impl.v3) - (define-builtin-link IO.systemTimeMicroseconds.impl.v3) - (define-builtin-link Universal.==) - (define-builtin-link Universal.>) - (define-builtin-link Universal.<) - (define-builtin-link Universal.>=) - (define-builtin-link Universal.<=) - (define-builtin-link Universal.compare) - (define-builtin-link Universal.murmurHash) - (define-builtin-link Pattern.captureAs) - (define-builtin-link Pattern.many.corrected) - (define-builtin-link Pattern.isMatch) - (define-builtin-link Char.Class.is) - (define-builtin-link Scope.bytearrayOf) - (define-builtin-link unsafe.coerceAbilities) - (define-builtin-link Clock.internals.systemTimeZone.v1) - +#lang racket/base +(provide + builtin-Float.* + builtin-Float.*:termlink + builtin-Float.>= + builtin-Float.>=:termlink + builtin-Float.<= + builtin-Float.<=:termlink + builtin-Float.> + builtin-Float.>:termlink + builtin-Float.< + builtin-Float.<:termlink + builtin-Float.== + builtin-Float.==:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.ceiling + builtin-Float.ceiling:termlink + builtin-Float.exp + builtin-Float.exp:termlink + builtin-Float.log + builtin-Float.log:termlink + builtin-Float.max + builtin-Float.max:termlink + builtin-Float.min + builtin-Float.min:termlink + builtin-Float.tan + builtin-Float.tan:termlink + builtin-Float.tanh + builtin-Float.tanh:termlink + builtin-Float.logBase + builtin-Float.logBase:termlink + builtin-Float.pow + builtin-Float.pow:termlink + builtin-Int.pow + builtin-Int.pow:termlink + builtin-Int.* + builtin-Int.*:termlink + builtin-Int.+ + builtin-Int.+:termlink + builtin-Int.- + builtin-Int.-:termlink + builtin-Int./ + builtin-Int./:termlink + builtin-Int.increment + builtin-Int.increment:termlink + builtin-Int.negate + builtin-Int.negate:termlink + builtin-Int.fromRepresentation + builtin-Int.fromRepresentation:termlink + builtin-Int.toRepresentation + builtin-Int.toRepresentation:termlink + builtin-Int.signum + builtin-Int.signum:termlink + builtin-Int.trailingZeros + builtin-Int.trailingZeros:termlink + builtin-Int.popCount + builtin-Int.popCount:termlink + builtin-Int.isEven + builtin-Int.isEven:termlink + builtin-Int.isOdd + builtin-Int.isOdd:termlink + builtin-Int.== + builtin-Int.==:termlink + builtin-Int.< + builtin-Int.<:termlink + builtin-Int.<= + builtin-Int.<=:termlink + builtin-Int.> + builtin-Int.>:termlink + builtin-Int.>= + builtin-Int.>=:termlink + builtin-Nat.+ + builtin-Nat.+:termlink + builtin-Nat.drop + builtin-Nat.drop:termlink + builtin-Nat.== + builtin-Nat.==:termlink + builtin-Nat.< + builtin-Nat.<:termlink + builtin-Nat.<= + builtin-Nat.<=:termlink + builtin-Nat.> + builtin-Nat.>:termlink + builtin-Nat.>= + builtin-Nat.>=:termlink + builtin-Nat.isEven + builtin-Nat.isEven:termlink + builtin-Nat.isOdd + builtin-Nat.isOdd:termlink + builtin-Nat.increment + builtin-Nat.increment:termlink + builtin-Nat.popCount + builtin-Nat.popCount:termlink + builtin-Nat.toFloat + builtin-Nat.toFloat:termlink + builtin-Nat.trailingZeros + builtin-Nat.trailingZeros:termlink + builtin-Text.indexOf + builtin-Text.indexOf:termlink + builtin-Text.== + builtin-Text.==:termlink + builtin-Text.!= + builtin-Text.!=:termlink + builtin-Text.<= + builtin-Text.<=:termlink + builtin-Text.>= + builtin-Text.>=:termlink + builtin-Text.< + builtin-Text.<:termlink + builtin-Text.> + builtin-Text.>:termlink + builtin-Bytes.indexOf + builtin-Bytes.indexOf:termlink + builtin-IO.randomBytes + builtin-IO.randomBytes:termlink + builtin-IO.tryEval + builtin-IO.tryEval:termlink + + builtin-Scope.bytearrayOf + builtin-Scope.bytearrayOf:termlink + + builtin-Universal.== + builtin-Universal.==:termlink + builtin-Universal.> + builtin-Universal.>:termlink + builtin-Universal.>= + builtin-Universal.>=:termlink + builtin-Universal.< + builtin-Universal.<:termlink + builtin-Universal.<= + builtin-Universal.<=:termlink + builtin-Universal.compare + builtin-Universal.compare:termlink + builtin-Universal.murmurHash:termlink + + builtin-unsafe.coerceAbilities + builtin-unsafe.coerceAbilities:termlink + + builtin-List.splitLeft + builtin-List.splitLeft:termlink + builtin-List.splitRight + builtin-List.splitRight:termlink + + builtin-Link.Term.toText + builtin-Link.Term.toText:termlink + + builtin-Value.toBuiltin + builtin-Value.toBuiltin:termlink + builtin-Value.fromBuiltin + builtin-Value.fromBuiltin:termlink + builtin-Code.fromGroup + builtin-Code.fromGroup:termlink + builtin-Code.toGroup + builtin-Code.toGroup:termlink + builtin-TermLink.fromReferent + builtin-TermLink.fromReferent:termlink + builtin-TermLink.toReferent + builtin-TermLink.toReferent:termlink + builtin-TypeLink.toReference + builtin-TypeLink.toReference:termlink + + builtin-IO.UDP.clientSocket.impl.v1 + builtin-IO.UDP.clientSocket.impl.v1:termlink + builtin-IO.UDP.UDPSocket.recv.impl.v1 + builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink + builtin-IO.UDP.UDPSocket.send.impl.v1 + builtin-IO.UDP.UDPSocket.send.impl.v1:termlink + builtin-IO.UDP.UDPSocket.close.impl.v1 + builtin-IO.UDP.UDPSocket.close.impl.v1:termlink + builtin-IO.UDP.ListenSocket.close.impl.v1 + builtin-IO.UDP.ListenSocket.close.impl.v1:termlink + builtin-IO.UDP.UDPSocket.toText.impl.v1 + builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink + builtin-IO.UDP.serverSocket.impl.v1 + builtin-IO.UDP.serverSocket.impl.v1:termlink + builtin-IO.UDP.ListenSocket.toText.impl.v1 + builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink + builtin-IO.UDP.ClientSockAddr.toText.v1 + builtin-IO.UDP.ClientSockAddr.toText.v1:termlink + builtin-IO.UDP.ListenSocket.sendTo.impl.v1 + builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink + + unison-FOp-internal.dataTag + unison-FOp-Char.toText + ; unison-FOp-Code.dependencies + ; unison-FOp-Code.serialize + unison-FOp-IO.closeFile.impl.v3 + unison-FOp-IO.openFile.impl.v3 + ; unison-FOp-IO.isFileEOF.impl.v3 + unison-FOp-IO.putBytes.impl.v3 + unison-FOp-IO.getBytes.impl.v3 + builtin-IO.seekHandle.impl.v3 + builtin-IO.seekHandle.impl.v3:termlink + builtin-IO.getLine.impl.v1 + builtin-IO.getLine.impl.v1:termlink + builtin-IO.getSomeBytes.impl.v1 + builtin-IO.getSomeBytes.impl.v1:termlink + builtin-IO.setBuffering.impl.v3 + builtin-IO.setBuffering.impl.v3:termlink + builtin-IO.getBuffering.impl.v3 + builtin-IO.getBuffering.impl.v3:termlink + builtin-IO.setEcho.impl.v1 + builtin-IO.setEcho.impl.v1:termlink + builtin-IO.isFileOpen.impl.v3 + builtin-IO.isFileOpen.impl.v3:termlink + builtin-IO.ready.impl.v1 + builtin-IO.ready.impl.v1:termlink + builtin-IO.process.call + builtin-IO.process.call:termlink + builtin-IO.getEcho.impl.v1 + builtin-IO.getEcho.impl.v1:termlink + builtin-IO.getArgs.impl.v1 + builtin-IO.getArgs.impl.v1:termlink + builtin-IO.getEnv.impl.v1 + builtin-IO.getEnv.impl.v1:termlink + builtin-IO.getChar.impl.v1 + builtin-IO.getChar.impl.v1:termlink + builtin-IO.getCurrentDirectory.impl.v3 + builtin-IO.getCurrentDirectory.impl.v3:termlink + builtin-IO.removeDirectory.impl.v3 + builtin-IO.removeDirectory.impl.v3:termlink + builtin-IO.renameFile.impl.v3 + builtin-IO.renameFile.impl.v3:termlink + builtin-IO.createTempDirectory.impl.v3 + builtin-IO.createTempDirectory.impl.v3:termlink + builtin-IO.createDirectory.impl.v3 + builtin-IO.createDirectory.impl.v3:termlink + builtin-IO.setCurrentDirectory.impl.v3 + builtin-IO.setCurrentDirectory.impl.v3:termlink + builtin-IO.renameDirectory.impl.v3 + builtin-IO.renameDirectory.impl.v3:termlink + builtin-IO.isDirectory.impl.v3 + builtin-IO.isDirectory.impl.v3:termlink + builtin-IO.isSeekable.impl.v3 + builtin-IO.isSeekable.impl.v3:termlink + builtin-IO.handlePosition.impl.v3 + builtin-IO.handlePosition.impl.v3:termlink + builtin-IO.systemTime.impl.v3 + builtin-IO.systemTime.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.impl.v3 + builtin-IO.systemTimeMicroseconds.impl.v3:termlink + + builtin-Char.Class.is + builtin-Char.Class.is:termlink + builtin-Pattern.captureAs + builtin-Pattern.captureAs:termlink + builtin-Pattern.many.corrected + builtin-Pattern.many.corrected:termlink + builtin-Pattern.isMatch + builtin-Pattern.isMatch:termlink + builtin-IO.fileExists.impl.v3 + builtin-IO.fileExists.impl.v3:termlink + builtin-IO.isFileEOF.impl.v3 + builtin-IO.isFileEOF.impl.v3:termlink + + unison-FOp-IO.getFileSize.impl.v3 + unison-FOp-IO.getFileTimestamp.impl.v3 + ; unison-FOp-IO.fileExists.impl.v3 + unison-FOp-IO.removeFile.impl.v3 + unison-FOp-IO.getTempDirectory.impl.v3 + unison-FOp-Text.fromUtf8.impl.v3 + unison-FOp-Text.repeat + unison-FOp-Text.reverse + unison-FOp-Text.toUtf8 + unison-FOp-Text.toLowercase + unison-FOp-Text.toUppercase + unison-FOp-Pattern.run + unison-FOp-Pattern.isMatch + unison-FOp-Pattern.many + unison-FOp-Pattern.capture + unison-FOp-Pattern.join + unison-FOp-Pattern.or + unison-FOp-Pattern.replicate + unison-FOp-Text.patterns.digit + unison-FOp-Text.patterns.letter + unison-FOp-Text.patterns.punctuation + unison-FOp-Text.patterns.charIn + unison-FOp-Text.patterns.notCharIn + unison-FOp-Text.patterns.anyChar + unison-FOp-Text.patterns.space + unison-FOp-Text.patterns.charRange + unison-FOp-Text.patterns.notCharRange + unison-FOp-Text.patterns.literal + unison-FOp-Text.patterns.eof + unison-FOp-Text.patterns.char + unison-FOp-Char.Class.is + unison-FOp-Char.Class.any + unison-FOp-Char.Class.alphanumeric + unison-FOp-Char.Class.upper + unison-FOp-Char.Class.lower + unison-FOp-Char.Class.number + unison-FOp-Char.Class.punctuation + unison-FOp-Char.Class.symbol + unison-FOp-Char.Class.letter + unison-FOp-Char.Class.whitespace + unison-FOp-Char.Class.control + unison-FOp-Char.Class.printable + unison-FOp-Char.Class.mark + unison-FOp-Char.Class.separator + unison-FOp-Char.Class.or + unison-FOp-Char.Class.range + unison-FOp-Char.Class.anyOf + unison-FOp-Char.Class.and + unison-FOp-Char.Class.not + unison-FOp-Clock.internals.nsec.v1 + unison-FOp-Clock.internals.sec.v1 + unison-FOp-Clock.internals.threadCPUTime.v1 + unison-FOp-Clock.internals.processCPUTime.v1 + unison-FOp-Clock.internals.realtime.v1 + unison-FOp-Clock.internals.monotonic.v1 + builtin-Clock.internals.systemTimeZone.v1 + builtin-Clock.internals.systemTimeZone.v1:termlink + + + ; unison-FOp-Value.serialize + unison-FOp-IO.stdHandle + unison-FOp-IO.getArgs.impl.v1 + + builtin-IO.directoryContents.impl.v3 + builtin-IO.directoryContents.impl.v3:termlink + unison-FOp-IO.systemTimeMicroseconds.v1 + + unison-FOp-ImmutableArray.copyTo! + unison-FOp-ImmutableArray.read + + unison-FOp-MutableArray.copyTo! + unison-FOp-MutableArray.freeze! + unison-FOp-MutableArray.freeze + unison-FOp-MutableArray.read + unison-FOp-MutableArray.write + + unison-FOp-MutableArray.size + unison-FOp-ImmutableArray.size + + unison-FOp-MutableByteArray.size + unison-FOp-ImmutableByteArray.size + + unison-FOp-MutableByteArray.length + unison-FOp-ImmutableByteArray.length + + unison-FOp-ImmutableByteArray.copyTo! + unison-FOp-ImmutableByteArray.read8 + unison-FOp-ImmutableByteArray.read16be + unison-FOp-ImmutableByteArray.read24be + unison-FOp-ImmutableByteArray.read32be + unison-FOp-ImmutableByteArray.read40be + unison-FOp-ImmutableByteArray.read48be + unison-FOp-ImmutableByteArray.read56be + unison-FOp-ImmutableByteArray.read64be + + unison-FOp-MutableByteArray.copyTo! + unison-FOp-MutableByteArray.freeze! + unison-FOp-MutableByteArray.write8 + unison-FOp-MutableByteArray.write16be + unison-FOp-MutableByteArray.write32be + unison-FOp-MutableByteArray.write64be + unison-FOp-MutableByteArray.read8 + unison-FOp-MutableByteArray.read16be + unison-FOp-MutableByteArray.read24be + unison-FOp-MutableByteArray.read32be + unison-FOp-MutableByteArray.read40be + unison-FOp-MutableByteArray.read64be + + unison-FOp-Scope.bytearray + unison-FOp-Scope.bytearrayOf + unison-FOp-Scope.array + unison-FOp-Scope.arrayOf + unison-FOp-Scope.ref + + unison-FOp-IO.bytearray + unison-FOp-IO.bytearrayOf + unison-FOp-IO.array + unison-FOp-IO.arrayOf + + unison-FOp-IO.ref + unison-FOp-Ref.read + unison-FOp-Ref.write + unison-FOp-Ref.readForCas + unison-FOp-Ref.Ticket.read + unison-FOp-Ref.cas + + unison-FOp-Promise.new + unison-FOp-Promise.read + unison-FOp-Promise.tryRead + unison-FOp-Promise.write + + unison-FOp-IO.delay.impl.v3 + unison-POp-FORK + unison-FOp-IO.kill.impl.v3 + + unison-FOp-Handle.toText + unison-FOp-Socket.toText + unison-FOp-ThreadId.toText + + unison-POp-ABSF + unison-POp-ACOS + unison-POp-ACSH + unison-POp-ADDF + unison-POp-ASIN + unison-POp-ASNH + unison-POp-ATAN + unison-POp-ATN2 + unison-POp-ATNH + unison-POp-CEIL + unison-POp-FLOR + unison-POp-COSF + unison-POp-COSH + unison-POp-DIVF + unison-POp-DIVI + unison-POp-EQLF + unison-POp-EQLI + unison-POp-SUBF + unison-POp-SUBI + unison-POp-SGNI + unison-POp-LEQF + unison-POp-SINF + unison-POp-SINH + unison-POp-TRNF + unison-POp-RNDF + unison-POp-SQRT + unison-POp-TANH + unison-POp-TANF + unison-POp-TZRO + unison-POp-POPC + unison-POp-ITOF + + unison-POp-ADDN + unison-POp-ANDN + unison-POp-BLDS + unison-POp-CATS + unison-POp-CATT + unison-POp-CATB + unison-POp-CMPU + unison-POp-COMN + unison-POp-CONS + unison-POp-DBTX + unison-POp-DECI + unison-POp-INCI + unison-POp-DECN + unison-POp-INCN + unison-POp-DIVN + unison-POp-DRPB + unison-POp-DRPS + unison-POp-DRPT + unison-POp-EQLN + unison-POp-EQLT + unison-POp-EXPF + unison-POp-LEQT + unison-POp-EQLU + unison-POp-EROR + unison-POp-FTOT + unison-POp-IDXB + unison-POp-IDXS + unison-POp-IORN + unison-POp-ITOT + unison-POp-LEQN + ; unison-POp-LKUP + unison-POp-LZRO + unison-POp-MULN + unison-POp-MODN + unison-POp-NTOT + unison-POp-PAKT + unison-POp-SHLI + unison-POp-SHLN + unison-POp-SHRI + unison-POp-SHRN + unison-POp-SIZS + unison-POp-SIZT + unison-POp-SIZB + unison-POp-SNOC + unison-POp-SUBN + unison-POp-SUBI + unison-POp-TAKS + unison-POp-TAKT + unison-POp-TAKB + unison-POp-TRCE + unison-POp-PRNT + unison-POp-TTON + unison-POp-TTOI + unison-POp-TTOF + unison-POp-UPKT + unison-POp-XORN + unison-POp-VALU + unison-POp-VWLS + unison-POp-UCNS + unison-POp-USNC + unison-POp-FLTB + unison-POp-MAXF + unison-POp-MINF + unison-POp-MULF + unison-POp-MULI + unison-POp-NEGI + unison-POp-NTOF + unison-POp-POWF + unison-POp-POWI + unison-POp-POWN + + unison-POp-UPKB + unison-POp-PAKB + unison-POp-ADDI + unison-POp-MULI + unison-POp-MODI + unison-POp-LEQI + unison-POp-LOGB + unison-POp-LOGF + unison-POp-POWN + unison-POp-VWRS + unison-POp-SPLL + unison-POp-SPLR + + unison-FOp-Bytes.gzip.compress + unison-FOp-Bytes.gzip.decompress + unison-FOp-Bytes.zlib.compress + unison-FOp-Bytes.zlib.decompress + unison-FOp-Bytes.toBase16 + unison-FOp-Bytes.toBase32 + unison-FOp-Bytes.toBase64 + unison-FOp-Bytes.toBase64UrlUnpadded + unison-FOp-Bytes.fromBase16 + unison-FOp-Bytes.fromBase32 + unison-FOp-Bytes.fromBase64 + unison-FOp-Bytes.fromBase64UrlUnpadded + unison-FOp-Bytes.encodeNat16be + unison-FOp-Bytes.encodeNat16le + unison-FOp-Bytes.encodeNat32be + unison-FOp-Bytes.encodeNat32le + unison-FOp-Bytes.encodeNat64be + unison-FOp-Bytes.encodeNat64le + unison-FOp-Bytes.decodeNat16be + unison-FOp-Bytes.decodeNat16le + unison-FOp-Bytes.decodeNat32be + unison-FOp-Bytes.decodeNat32le + unison-FOp-Bytes.decodeNat64be + unison-FOp-Bytes.decodeNat64le + + unison-FOp-crypto.hashBytes + unison-FOp-crypto.hmacBytes + unison-FOp-crypto.HashAlgorithm.Md5 + unison-FOp-crypto.HashAlgorithm.Sha1 + unison-FOp-crypto.HashAlgorithm.Sha2_256 + unison-FOp-crypto.HashAlgorithm.Sha2_512 + unison-FOp-crypto.HashAlgorithm.Sha3_256 + unison-FOp-crypto.HashAlgorithm.Sha3_512 + unison-FOp-crypto.HashAlgorithm.Blake2s_256 + unison-FOp-crypto.HashAlgorithm.Blake2b_256 + unison-FOp-crypto.HashAlgorithm.Blake2b_512 + + unison-FOp-IO.clientSocket.impl.v3 + unison-FOp-IO.closeSocket.impl.v3 + unison-FOp-IO.socketReceive.impl.v3 + unison-FOp-IO.socketSend.impl.v3 + unison-FOp-IO.socketPort.impl.v3 + unison-FOp-IO.serverSocket.impl.v3 + unison-FOp-IO.socketAccept.impl.v3 + unison-FOp-IO.listen.impl.v3 + unison-FOp-Tls.ClientConfig.default + unison-FOp-Tls.ClientConfig.certificates.set + unison-FOp-Tls.decodeCert.impl.v3 + unison-FOp-Tls.encodeCert + unison-FOp-Tls.newServer.impl.v3 + unison-FOp-Tls.decodePrivateKey + unison-FOp-Tls.encodePrivateKey + unison-FOp-Tls.ServerConfig.default + unison-FOp-Tls.handshake.impl.v3 + unison-FOp-Tls.newClient.impl.v3 + unison-FOp-Tls.receive.impl.v3 + unison-FOp-Tls.send.impl.v3 + unison-FOp-Tls.terminate.impl.v3 + + ; fake builtins + builtin-murmurHashBytes) + +(require + (except-in racket + eof + sleep) + + (only-in srfi/13 string-reverse) + rnrs/bytevectors-6 + + racket/performance-hint + + (only-in racket/flonum + fl< + fl> + fl<= + fl>= + fl=) + + (only-in racket/string + string-contains? + string-replace) + + unison/arithmetic + unison/bytevector + unison/core + + (only-in unison/boot + define-unison-builtin + referent->termlink + termlink->referent + typelink->reference + clamp-integer + clamp-natural + wrap-natural + exn:bug->exception + raise-unison-exception + bit64 + bit63 + nbit63) + + unison/data + unison/data-info + unison/math + unison/chunked-seq + unison/chunked-bytes + unison/string-search + unison/bytes-nat + unison/pattern + unison/crypto + unison/io + unison/io-handles + unison/murmurhash + unison/tls + unison/tcp + unison/udp + unison/gzip + unison/zlib + unison/concurrent + racket/random) + +; (define-builtin-link Float.*) +; (define-builtin-link Float.fromRepresentation) +; (define-builtin-link Float.toRepresentation) +; (define-builtin-link Float.ceiling) +; (define-builtin-link Float.exp) +; (define-builtin-link Float.log) +; (define-builtin-link Float.max) +; (define-builtin-link Float.min) +; (define-builtin-link Float.tan) +; (define-builtin-link Float.tanh) +; (define-builtin-link Float.logBase) +; (define-builtin-link Float.pow) +; (define-builtin-link Float.>) +; (define-builtin-link Float.<) +; (define-builtin-link Float.>=) +; (define-builtin-link Float.<=) +; (define-builtin-link Float.==) +; (define-builtin-link Int.pow) +; (define-builtin-link Int.*) +; (define-builtin-link Int.+) +; (define-builtin-link Int.-) +; (define-builtin-link Int./) +; (define-builtin-link Int.>) +; (define-builtin-link Int.<) +; (define-builtin-link Int.>=) +; (define-builtin-link Int.<=) +; (define-builtin-link Int.==) +; (define-builtin-link Int.isEven) +; (define-builtin-link Int.isOdd) +; (define-builtin-link Int.increment) +; (define-builtin-link Int.negate) +; (define-builtin-link Int.fromRepresentation) +; (define-builtin-link Int.toRepresentation) +; (define-builtin-link Int.signum) +; (define-builtin-link Int.trailingZeros) +; (define-builtin-link Int.popCount) +; (define-builtin-link Nat.increment) +; (define-builtin-link Nat.popCount) +; (define-builtin-link Nat.toFloat) +; (define-builtin-link Nat.trailingZeros) +; (define-builtin-link Nat.+) +; (define-builtin-link Nat.>) +; (define-builtin-link Nat.<) +; (define-builtin-link Nat.>=) +; (define-builtin-link Nat.<=) +; (define-builtin-link Nat.==) +; (define-builtin-link Nat.drop) +; (define-builtin-link Nat.isEven) +; (define-builtin-link Nat.isOdd) +; (define-builtin-link Text.indexOf) +; (define-builtin-link Text.>) +; (define-builtin-link Text.<) +; (define-builtin-link Text.>=) +; (define-builtin-link Text.<=) +; (define-builtin-link Text.==) +; (define-builtin-link Text.!=) +; (define-builtin-link Bytes.indexOf) +; (define-builtin-link IO.randomBytes) +; (define-builtin-link IO.tryEval) +; (define-builtin-link List.splitLeft) +; (define-builtin-link List.splitRight) +; (define-builtin-link Value.toBuiltin) +; (define-builtin-link Value.fromBuiltin) +; (define-builtin-link Code.fromGroup) +; (define-builtin-link Code.toGroup) +; (define-builtin-link TermLink.fromReferent) +; (define-builtin-link TermLink.toReferent) +; (define-builtin-link TypeLink.toReference) +; (define-builtin-link IO.seekHandle.impl.v3) +; (define-builtin-link IO.getLine.impl.v1) +; (define-builtin-link IO.getSomeBytes.impl.v1) +; (define-builtin-link IO.setBuffering.impl.v3) +; (define-builtin-link IO.getBuffering.impl.v3) +; (define-builtin-link IO.setEcho.impl.v1) +; (define-builtin-link IO.isFileOpen.impl.v3) +; (define-builtin-link IO.ready.impl.v1) +; (define-builtin-link IO.process.call) +; (define-builtin-link IO.getEcho.impl.v1) +; (define-builtin-link IO.getArgs.impl.v1) +; (define-builtin-link IO.getEnv.impl.v1) +; (define-builtin-link IO.getChar.impl.v1) +; (define-builtin-link IO.getCurrentDirectory.impl.v3) +; (define-builtin-link IO.directoryContents.impl.v3) +; (define-builtin-link IO.removeDirectory.impl.v3) +; (define-builtin-link IO.renameFile.impl.v3) +; (define-builtin-link IO.createTempDirectory.impl.v3) +; (define-builtin-link IO.createDirectory.impl.v3) +; (define-builtin-link IO.setCurrentDirectory.impl.v3) +; (define-builtin-link IO.renameDirectory.impl.v3) +; (define-builtin-link IO.fileExists.impl.v3) +; (define-builtin-link IO.isDirectory.impl.v3) +; (define-builtin-link IO.isFileEOF.impl.v3) +; (define-builtin-link IO.isSeekable.impl.v3) +; (define-builtin-link IO.handlePosition.impl.v3) +; (define-builtin-link IO.systemTime.impl.v3) +; (define-builtin-link IO.systemTimeMicroseconds.impl.v3) +; (define-builtin-link Universal.==) +; (define-builtin-link Universal.>) +; (define-builtin-link Universal.<) +; (define-builtin-link Universal.>=) +; (define-builtin-link Universal.<=) +; (define-builtin-link Universal.compare) +(define-builtin-link Universal.murmurHash) +; (define-builtin-link Pattern.captureAs) +; (define-builtin-link Pattern.many.corrected) +; (define-builtin-link Pattern.isMatch) +; (define-builtin-link Char.Class.is) +; (define-builtin-link Scope.bytearrayOf) +; (define-builtin-link unsafe.coerceAbilities) +(define-builtin-link Clock.internals.systemTimeZone.v1) + +(begin-encourage-inline + (define-unison-builtin (builtin-Value.toBuiltin v) (unison-quote v)) + (define-unison-builtin (builtin-Value.fromBuiltin v) + (unison-quote-val v)) + (define-unison-builtin (builtin-Code.fromGroup sg) (unison-code sg)) + (define-unison-builtin (builtin-Code.toGroup co) + (unison-code-rep co)) + (define-unison-builtin (builtin-TermLink.fromReferent rf) + (referent->termlink rf)) + (define-unison-builtin (builtin-TermLink.toReferent tl) + (termlink->referent tl)) + (define-unison-builtin (builtin-TypeLink.toReference tl) + (typelink->reference tl)) + (define-unison-builtin (builtin-murmurHashBytes bs) + (murmurhash-bytes (chunked-bytes->bytes bs))) + + (define-unison-builtin (builtin-IO.randomBytes n) + (bytes->chunked-bytes (crypto-random-bytes n))) + + (define-unison-builtin (builtin-List.splitLeft n s) + (match (unison-POp-SPLL n s) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) + + (define-unison-builtin (builtin-List.splitRight n s) + (match (unison-POp-SPLR n s) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) + + (define-unison-builtin (builtin-Float.> x y) (fl> x y)) + (define-unison-builtin (builtin-Float.< x y) (fl< x y)) + (define-unison-builtin (builtin-Float.>= x y) (fl>= x y)) + (define-unison-builtin (builtin-Float.<= x y) (fl<= x y)) + (define-unison-builtin (builtin-Float.== x y) (fl= x y)) + + (define-unison-builtin (builtin-Int.> x y) (> x y)) + (define-unison-builtin (builtin-Int.< x y) (< x y)) + (define-unison-builtin (builtin-Int.>= x y) (>= x y)) + (define-unison-builtin (builtin-Int.<= x y) (<= x y)) + (define-unison-builtin (builtin-Int.== x y) (= x y)) + (define-unison-builtin (builtin-Int.isEven x) (even? x)) + (define-unison-builtin (builtin-Int.isOdd x) (odd? x)) + + (define-unison-builtin (builtin-Nat.> x y) (> x y)) + (define-unison-builtin (builtin-Nat.< x y) (< x y)) + (define-unison-builtin (builtin-Nat.>= x y) (>= x y)) + (define-unison-builtin (builtin-Nat.<= x y) (<= x y)) (begin-encourage-inline - (define-unison (builtin-Value.toBuiltin v) (unison-quote v)) - (define-unison (builtin-Value.fromBuiltin v) - (unison-quote-val v)) - (define-unison (builtin-Code.fromGroup sg) (unison-code sg)) - (define-unison (builtin-Code.toGroup co) - (unison-code-rep co)) - (define-unison (builtin-TermLink.fromReferent rf) - (referent->termlink rf)) - (define-unison (builtin-TermLink.toReferent tl) - (termlink->referent tl)) - (define-unison (builtin-TypeLink.toReference tl) - (typelink->reference tl)) - (define-unison (builtin-murmurHashBytes bs) - (murmurhash-bytes (chunked-bytes->bytes bs))) - - (define-unison (builtin-IO.randomBytes n) - (bytes->chunked-bytes (crypto-random-bytes n))) - - (define-unison (builtin-List.splitLeft n s) - (match (unison-POp-SPLL n s) - [(unison-sum 0 fs) ref-seqview-empty] - [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) - - (define-unison (builtin-List.splitRight n s) - (match (unison-POp-SPLR n s) - [(unison-sum 0 fs) ref-seqview-empty] - [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) - - (define-unison (builtin-Float.> x y) (fl> x y)) - (define-unison (builtin-Float.< x y) (fl< x y)) - (define-unison (builtin-Float.>= x y) (fl>= x y)) - (define-unison (builtin-Float.<= x y) (fl<= x y)) - (define-unison (builtin-Float.== x y) (fl= x y)) - - (define-unison (builtin-Int.> x y) (> x y)) - (define-unison (builtin-Int.< x y) (< x y)) - (define-unison (builtin-Int.>= x y) (>= x y)) - (define-unison (builtin-Int.<= x y) (<= x y)) - (define-unison (builtin-Int.== x y) (= x y)) - (define-unison (builtin-Int.isEven x) (even? x)) - (define-unison (builtin-Int.isOdd x) (odd? x)) - - (define-unison (builtin-Nat.> x y) (> x y)) - (define-unison (builtin-Nat.< x y) (< x y)) - (define-unison (builtin-Nat.>= x y) (>= x y)) - (define-unison (builtin-Nat.<= x y) (<= x y)) - (begin-encourage-inline - (define-unison (builtin-Nat.== x y) (= x y))) - - (define-unison (builtin-Nat.isEven x) (even? x)) - (define-unison (builtin-Nat.isOdd x) (odd? x)) - - ; Note: chunked-string x y) - (not (chunked-string= x y) (chunked-string x y) - (case (universal-compare x y) [(>) #t] [else #f])) - (define-unison (builtin-Universal.< x y) - (case (universal-compare x y) [(<) #t] [else #f])) - (define-unison (builtin-Universal.<= x y) - (case (universal-compare x y) [(>) #f] [else #t])) - (define-unison (builtin-Universal.>= x y) - (case (universal-compare x y) [(<) #f] [else #t])) - (define-unison (builtin-Universal.compare x y) - (case (universal-compare x y) - [(>) 1] [(<) -1] [else 0])) - - (define-unison (builtin-Scope.bytearrayOf i n) - (make-bytevector n i)) - - (define-builtin-link Link.Type.toText) - (define-unison (builtin-Link.Type.toText ln) - (string->chunked-string (typelink->string ln))) - - (define-builtin-link Link.Term.toText) - (define-unison (builtin-Link.Term.toText ln) - (string->chunked-string (termlink->string ln))) - - (define-unison (builtin-Char.Class.is cc c) - (pattern-match? cc (string->chunked-string (string c)))) - - (define-unison (builtin-Pattern.captureAs c p) - (capture-as c p)) - - (define-unison (builtin-Pattern.many.corrected p) (many p)) - - (define-unison (builtin-Pattern.isMatch p s) - (pattern-match? p s)) - - (define-unison (builtin-unsafe.coerceAbilities f) f) - - (define (unison-POp-UPKB bs) - (build-chunked-list - (chunked-bytes-length bs) - (lambda (i) (chunked-bytes-ref bs i)))) - - (define (unison-POp-ADDI i j) (clamp-integer (+ i j))) - (define (unison-POp-MULI i j) (clamp-integer (* i j))) - (define (unison-POp-MODI i j) (clamp-integer (modulo i j))) - (define (unison-POp-LEQI a b) (bool (<= a b))) - (define (unison-POp-POWN m n) (clamp-natural (expt m n))) - (define unison-POp-LOGF log) - - (define (reify-exn thunk) - (guard - (e [else - (sum 0 '() (exception->string e) ref-unit-unit)]) - (thunk))) - - ; Core implemented primops, upon which primops-in-unison can be built. - (define (unison-POp-ADDN m n) (clamp-natural (+ m n))) - (define (unison-POp-ANDN m n) (bitwise-and m n)) - (define unison-POp-BLDS - (lambda args-list - (fold-right (lambda (e l) (chunked-list-add-first l e)) empty-chunked-list args-list))) - (define (unison-POp-CATS l r) (chunked-list-append l r)) - (define (unison-POp-CATT l r) (chunked-string-append l r)) - (define (unison-POp-CATB l r) (chunked-bytes-append l r)) - (define (unison-POp-CMPU l r) (ord (universal-compare l r))) - (define (unison-POp-COMN n) (wrap-natural (bitwise-not n))) - (define (unison-POp-CONS x xs) (chunked-list-add-first xs x)) - (define (unison-POp-DECI n) (clamp-integer (sub1 n))) - (define (unison-POp-INCI n) (clamp-integer (add1 n))) - (define (unison-POp-DECN n) (wrap-natural (sub1 n))) - (define (unison-POp-INCN n) (clamp-natural (add1 n))) - (define (unison-POp-DIVN m n) (quotient m n)) - (define (unison-POp-DRPB n bs) (chunked-bytes-drop bs n)) - (define (unison-POp-DRPS n l) (chunked-list-drop l n)) - (define (unison-POp-DRPT n t) (chunked-string-drop t n)) - (define (unison-POp-EQLN m n) (bool (= m n))) - (define (unison-POp-EQLT s t) (bool (equal? s t))) - (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)]) - (put-string p snm) - (put-string p ": ") - (display (describe-value x) p) - (raise (make-exn:bug snm x)))) - (define (unison-POp-FTOT f) - (define base (number->string f)) - (define dotted - (if (string-contains? base ".") - base - (string-replace base "e" ".0e"))) - (string->chunked-string - (string-replace dotted "+" ""))) - (define (unison-POp-IDXB n bs) - (guard (x [else none]) - (some (chunked-bytes-ref bs n)))) - (define (unison-POp-IDXS n l) - (guard (x [else none]) - (some (chunked-list-ref l n)))) - (define (unison-POp-IORN m n) (bitwise-ior m n)) - (define (unison-POp-ITOT n) - (string->chunked-string (number->string n))) - (define (unison-POp-LEQN m n) (bool (fx<=? m n))) - (define (unison-POp-LZRO m) (- 64 (integer-length m))) - (define (unison-POp-MULN m n) (clamp-natural (* m n))) - (define (unison-POp-MODN m n) (modulo m n)) - (define (unison-POp-NTOT n) (string->chunked-string (number->string n))) - (define (unison-POp-PAKB l) - (build-chunked-bytes - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-PAKT l) - (build-chunked-string - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-SHLI i k) - (clamp-integer (bitwise-arithmetic-shift-left i k))) - (define (unison-POp-SHLN n k) - (clamp-natural (bitwise-arithmetic-shift-left n k))) - (define (unison-POp-SHRI i k) (bitwise-arithmetic-shift-right i k)) - (define (unison-POp-SHRN n k) (bitwise-arithmetic-shift-right n k)) - (define (unison-POp-SIZS l) (chunked-list-length l)) - (define (unison-POp-SIZT t) (chunked-string-length t)) - (define (unison-POp-SIZB b) (chunked-bytes-length b)) - (define (unison-POp-SNOC xs x) (chunked-list-add-last xs x)) - (define (unison-POp-SUBN m n) (clamp-integer (- m n))) - (define (unison-POp-SUBI m n) (clamp-integer (- m n))) - (define (unison-POp-TAKS n s) (chunked-list-take s n)) - (define (unison-POp-TAKT n t) (chunked-string-take t n)) - (define (unison-POp-TAKB n t) (chunked-bytes-take t n)) - - (define (->optional v) - (if v - (ref-optional-some v) - ref-optional-none)) - - (define-unison (builtin-Text.indexOf n h) - (->optional (chunked-string-index-of h n))) - (define-unison (builtin-Bytes.indexOf n h) - (->optional (chunked-bytes-index-of h n))) - - ;; TODO currently only runs in low-level tracing support - (define (unison-POp-DBTX x) - (sum 1 (string->chunked-string (describe-value x)))) - - (define (unison-FOp-Handle.toText h) - (string->chunked-string (describe-value h))) - (define (unison-FOp-Socket.toText s) - (string->chunked-string (describe-value s))) - (define (unison-FOp-ThreadId.toText tid) - (string->chunked-string (describe-value tid))) - - (define (unison-POp-TRCE s x) - (display "trace: ") - (display (chunked-string->string s)) - (newline) - (display (describe-value x)) - (newline)) - (define (unison-POp-PRNT s) - (display (chunked-string->string s)) - (newline)) - (define (unison-POp-TTON s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-nonnegative-integer? mn) (< mn bit64)) - (some mn) - none))) - (define (unison-POp-TTOI s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) - (some mn) - none))) - (define (unison-POp-TTOF s) - (let ([mn (string->number (chunked-string->string s))]) - (if mn (some mn) none))) - (define (unison-POp-UPKT s) - (build-chunked-list - (chunked-string-length s) - (lambda (i) (chunked-string-ref s i)))) - (define (unison-POp-VWLS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-first l)]) - (sum 1 h t)))) - (define (unison-POp-VWRS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-last l)]) - (sum 1 t h)))) - (define (unison-POp-SPLL i s) - (if (< (chunked-list-length s) i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s i)]) - (sum 1 l r)))) - (define (unison-POp-SPLR i s) ; TODO write test that stresses this - (let ([len (chunked-list-length s) ]) - (if (< len i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s (- len i))]) - (sum 1 l r))))) - - (define (unison-POp-UCNS s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-first s)]) - (sum 1 (char h) t)))) - - (define (unison-POp-USNC s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-last s)]) - (sum 1 t (char h))))) - - ;; TODO flatten operation on Bytes is a no-op for now (and possibly ever) - (define (unison-POp-FLTB b) b) - - (define (unison-POp-XORN m n) (bitwise-xor m n)) - (define (unison-POp-VALU c) (decode-value c)) - - (define (unison-FOp-ImmutableByteArray.read16be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u16-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read24be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u24-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read32be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u32-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read40be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u40-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read48be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u48-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read56be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u56-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read64be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u64-ref bs n 'big))))) - - (define unison-FOp-internal.dataTag unison-data-tag) - - (define (unison-FOp-IO.getBytes.impl.v3 p n) - (reify-exn - (lambda () - (right - (bytes->chunked-bytes - (get-bytevector-n p n)))))) - - (define (unison-FOp-IO.putBytes.impl.v3 p bs) - (begin - (put-bytevector p (chunked-bytes->bytes bs)) - (flush-output-port p) - (sum 1 #f))) - - (define (unison-FOp-Char.toText c) (string->chunked-string (string (integer->char c)))) - - (define (unison-FOp-IO.getArgs.impl.v1) - (sum 1 (cdr (command-line)))) - - (define unison-FOp-IO.systemTimeMicroseconds.v1 current-microseconds) - - ;; TODO should we convert Bytes -> Text directly without the intermediate conversions? - (define (unison-FOp-Text.fromUtf8.impl.v3 b) - (with-handlers - ([exn:fail:contract? - (lambda (e) - (exception - ref-iofailure:typelink - (string->chunked-string - (string-append - "Invalid UTF-8 stream: " - (describe-value b))) - (exception->string e)))]) - (right (string->chunked-string (bytes->string/utf-8 (chunked-bytes->bytes b)))))) - - ;; TODO should we convert Text -> Bytes directly without the intermediate conversions? - (define (unison-FOp-Text.toUtf8 s) - (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) - - (define-unison (builtin-IO.isFileEOF.impl.v3 p) - (ref-either-right (port-eof? p))) - - (define (unison-FOp-IO.closeFile.impl.v3 h) - (if (input-port? h) - (close-input-port h) - (close-output-port h)) - (right none)) - - (define (unison-FOp-Text.repeat n t) - (let loop ([cnt 0] - [acc empty-chunked-string]) - (if (= cnt n) - acc - (loop (+ cnt 1) (chunked-string-append acc t))))) - - (define (unison-FOp-Text.reverse s) - (chunked-string-foldMap-chunks - s - string-reverse - (lambda (acc c) (chunked-string-append c acc)))) - - (define (unison-FOp-Text.toLowercase s) - (chunked-string-foldMap-chunks s string-downcase chunked-string-append)) - - (define (unison-FOp-Text.toUppercase s) - (chunked-string-foldMap-chunks s string-upcase chunked-string-append)) - - (define (unison-FOp-Pattern.run p s) - (let* ([r (pattern-match p s)]) - (if r (sum 1 (icdr r) (icar r)) (sum 0)))) - - (define (unison-FOp-Pattern.isMatch p s) (bool (pattern-match? p s))) - (define (unison-FOp-Pattern.many p) (many p)) - (define (unison-FOp-Pattern.capture p) (capture p)) - (define (unison-FOp-Pattern.join ps) - (join* ps)) - (define (unison-FOp-Pattern.or p1 p2) (choice p1 p2)) - (define (unison-FOp-Pattern.replicate n m p) (replicate p n m)) - - (define (unison-FOp-Text.patterns.digit) digit) - (define (unison-FOp-Text.patterns.letter) letter) - (define (unison-FOp-Text.patterns.punctuation) punctuation) - (define (unison-FOp-Text.patterns.charIn cs) (chars cs)) - (define (unison-FOp-Text.patterns.notCharIn cs) (not-chars cs)) - (define (unison-FOp-Text.patterns.anyChar) any-char) - (define (unison-FOp-Text.patterns.space) space) - (define (unison-FOp-Text.patterns.charRange a z) (char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.notCharRange a z) (not-char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.literal s) (literal s)) - (define (unison-FOp-Text.patterns.eof) eof) - (define (unison-FOp-Text.patterns.char cc) cc) - (define (unison-FOp-Char.Class.is cc c) - (unison-FOp-Pattern.isMatch cc (unison-FOp-Char.toText c))) - (define (unison-FOp-Char.Class.any) (unison-FOp-Text.patterns.anyChar)) - (define (unison-FOp-Char.Class.punctuation) - (unison-FOp-Text.patterns.punctuation)) - (define (unison-FOp-Char.Class.letter) (unison-FOp-Text.patterns.letter)) - (define (unison-FOp-Char.Class.alphanumeric) alphanumeric) - (define (unison-FOp-Char.Class.upper) upper) - (define (unison-FOp-Char.Class.lower) lower) - (define (unison-FOp-Char.Class.number) number) - (define (unison-FOp-Char.Class.symbol) symbol) - (define (unison-FOp-Char.Class.whitespace) space) - (define (unison-FOp-Char.Class.control) control) - (define (unison-FOp-Char.Class.printable) printable) - (define (unison-FOp-Char.Class.mark) mark) - (define (unison-FOp-Char.Class.separator) separator) - (define (unison-FOp-Char.Class.or p1 p2) (char-class-or p1 p2)) - (define (unison-FOp-Char.Class.range a z) - (unison-FOp-Text.patterns.charRange a z)) - (define (unison-FOp-Char.Class.anyOf cs) (unison-FOp-Text.patterns.charIn cs)) - (define (unison-FOp-Char.Class.and cc1 cc2) (char-class-and cc1 cc2)) - (define (unison-FOp-Char.Class.not cc) (char-class-not cc)) - - (define (catch-array thunk) - (reify-exn thunk)) - - (define (unison-FOp-ImmutableArray.read vec i) - (catch-array - (lambda () - (sum 1 (vector-ref vec i))))) - - (define (unison-FOp-ImmutableArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (vector-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-MutableArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (vector-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableArray.freeze! freeze-vector!) - - (define unison-FOp-MutableArray.freeze freeze-subvector) - - (define (unison-FOp-MutableArray.read src i) - (catch-array - (lambda () - (sum 1 (vector-ref src i))))) - - (define (unison-FOp-MutableArray.write dst i x) - (catch-array - (lambda () - (vector-set! dst i x) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (bytes-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (bytes-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableByteArray.freeze! freeze-bytevector!) - - (define (unison-FOp-MutableByteArray.write8 arr i b) - (catch-array - (lambda () - (bytevector-u8-set! arr i b) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write16be arr i b) - (catch-array - (lambda () - (bytevector-u16-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write32be arr i b) - (catch-array - (lambda () - (bytevector-u32-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write64be arr i b) - (catch-array - (lambda () - (bytevector-u64-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.read16be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u16-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read24be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u24-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read32be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u32-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read40be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u40-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read64be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u64-ref arr i 'big))))) - - (define (unison-FOp-Scope.bytearray n) (make-bytevector n)) - (define (unison-FOp-IO.bytearray n) (make-bytevector n)) - - (define (unison-FOp-Scope.array n) (make-vector n)) - (define (unison-FOp-IO.array n) (make-vector n)) - - (define (unison-FOp-Scope.bytearrayOf b n) (make-bytevector n b)) - (define (unison-FOp-IO.bytearrayOf b n) (make-bytevector n b)) - - (define (unison-FOp-Scope.arrayOf v n) (make-vector n v)) - (define (unison-FOp-IO.arrayOf v n) (make-vector n v)) - - (define unison-FOp-MutableByteArray.length bytevector-length) - (define unison-FOp-ImmutableByteArray.length bytevector-length) - (define unison-FOp-MutableByteArray.size bytevector-length) - (define unison-FOp-ImmutableByteArray.size bytevector-length) - (define unison-FOp-MutableArray.size vector-length) - (define unison-FOp-ImmutableArray.size vector-length) - - (define (unison-POp-FORK thunk) (fork thunk)) - (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros)) - (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId)) - (define (unison-FOp-Scope.ref a) (ref-new a)) - (define (unison-FOp-IO.ref a) (ref-new a)) - (define (unison-FOp-Ref.read ref) (ref-read ref)) - (define (unison-FOp-Ref.write ref a) (ref-write ref a)) - (define (unison-FOp-Ref.readForCas ref) (ref-read ref)) - (define (unison-FOp-Ref.Ticket.read ticket) ticket) - (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value)) - (define (unison-FOp-Promise.new) (promise-new)) - (define (unison-FOp-Promise.read promise) (promise-read promise)) - (define (unison-FOp-Promise.tryRead promise) (promise-try-read promise)) - (define (unison-FOp-Promise.write promise a) (promise-write promise a))) - - - (define (exn:io? e) - (or (exn:fail:read? e) - (exn:fail:filesystem? e) - (exn:fail:network? e))) - - (define (exn:arith? e) - (or (exn:fail:contract:divide-by-zero? e) - (exn:fail:contract:non-fixnum-result? e))) - - (define-unison (builtin-IO.tryEval thunk) + (define-unison-builtin (builtin-Nat.== x y) (= x y))) + + (define-unison-builtin (builtin-Nat.isEven x) (even? x)) + (define-unison-builtin (builtin-Nat.isOdd x) (odd? x)) + + ; Note: chunked-string x y) + (not (chunked-string= x y) (chunked-string x y) + (case (universal-compare x y) [(>) #t] [else #f])) + (define-unison-builtin (builtin-Universal.< x y) + (case (universal-compare x y) [(<) #t] [else #f])) + (define-unison-builtin (builtin-Universal.<= x y) + (case (universal-compare x y) [(>) #f] [else #t])) + (define-unison-builtin (builtin-Universal.>= x y) + (case (universal-compare x y) [(<) #f] [else #t])) + (define-unison-builtin (builtin-Universal.compare x y) + (case (universal-compare x y) + [(>) 1] [(<) -1] [else 0])) + + (define-unison-builtin (builtin-Scope.bytearrayOf i n) + (make-bytes n i)) + + ; (define-builtin-link Link.Type.toText) + (define-unison-builtin (builtin-Link.Type.toText ln) + (string->chunked-string (typelink->string ln))) + + ; (define-builtin-link Link.Term.toText) + (define-unison-builtin (builtin-Link.Term.toText ln) + (string->chunked-string (termlink->string ln))) + + (define-unison-builtin (builtin-Char.Class.is cc c) + (pattern-match? cc (string->chunked-string (string c)))) + + (define-unison-builtin (builtin-Pattern.captureAs c p) + (capture-as c p)) + + (define-unison-builtin (builtin-Pattern.many.corrected p) (many p)) + + (define-unison-builtin (builtin-Pattern.isMatch p s) + (pattern-match? p s)) + + (define-unison-builtin (builtin-unsafe.coerceAbilities f) f) + + (define (unison-POp-UPKB bs) + (build-chunked-list + (chunked-bytes-length bs) + (lambda (i) (chunked-bytes-ref bs i)))) + + (define (unison-POp-ADDI i j) (clamp-integer (+ i j))) + (define (unison-POp-MULI i j) (clamp-integer (* i j))) + (define (unison-POp-MODI i j) (clamp-integer (modulo i j))) + (define (unison-POp-LEQI a b) (bool (<= a b))) + (define (unison-POp-POWN m n) (clamp-natural (expt m n))) + (define unison-POp-LOGF log) + + (define (reify-exn thunk) (with-handlers - ([exn:break? - (lambda (e) - (raise-unison-exception - ref-threadkilledfailure:typelink - (string->chunked-string "thread killed") - ref-unit-unit))] - [exn:io? - (lambda (e) - (raise-unison-exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:arith? + ([exn:fail:contract? (lambda (e) - (raise-unison-exception - ref-arithfailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:bug? (lambda (e) (exn:bug->exception e))] - [exn:fail? - (lambda (e) - (raise-unison-exception - ref-runtimefailure:typelink - (exception->string e) - ref-unit-unit))] - [(lambda (x) #t) + (sum 0 '() (exception->string e) ref-unit-unit))]) + (thunk))) + + ; Core implemented primops, upon which primops-in-unison can be built. + (define (unison-POp-ADDN m n) (clamp-natural (+ m n))) + (define (unison-POp-ANDN m n) (bitwise-and m n)) + (define unison-POp-BLDS + (lambda args-list + (foldr (lambda (e l) (chunked-list-add-first l e)) empty-chunked-list args-list))) + (define (unison-POp-CATS l r) (chunked-list-append l r)) + (define (unison-POp-CATT l r) (chunked-string-append l r)) + (define (unison-POp-CATB l r) (chunked-bytes-append l r)) + (define (unison-POp-CMPU l r) (ord (universal-compare l r))) + (define (unison-POp-COMN n) (wrap-natural (bitwise-not n))) + (define (unison-POp-CONS x xs) (chunked-list-add-first xs x)) + (define (unison-POp-DECI n) (clamp-integer (sub1 n))) + (define (unison-POp-INCI n) (clamp-integer (add1 n))) + (define (unison-POp-DECN n) (wrap-natural (sub1 n))) + (define (unison-POp-INCN n) (clamp-natural (add1 n))) + (define (unison-POp-DIVN m n) (quotient m n)) + (define (unison-POp-DRPB n bs) (chunked-bytes-drop bs n)) + (define (unison-POp-DRPS n l) (chunked-list-drop l n)) + (define (unison-POp-DRPT n t) (chunked-string-drop t n)) + (define (unison-POp-EQLN m n) (bool (= m n))) + (define (unison-POp-EQLT s t) (bool (equal? s t))) + (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)]) + (raise (make-exn:bug snm x)))) + (define (unison-POp-FTOT f) + (define base (number->string f)) + (define dotted + (if (string-contains? base ".") + base + (string-replace base "e" ".0e"))) + (string->chunked-string + (string-replace dotted "+" ""))) + (define (unison-POp-IDXB n bs) + (with-handlers + ([exn:fail:contract? (lambda (e) none)]) + (some (chunked-bytes-ref bs n)))) + (define (unison-POp-IDXS n l) + (with-handlers + ([exn:fail:contract? (lambda (x) none)]) + (some (chunked-list-ref l n)))) + (define (unison-POp-IORN m n) (bitwise-ior m n)) + (define (unison-POp-ITOT n) + (string->chunked-string (number->string n))) + (define (unison-POp-LEQN m n) (bool (<= m n))) + (define (unison-POp-LZRO m) (- 64 (integer-length m))) + (define (unison-POp-MULN m n) (clamp-natural (* m n))) + (define (unison-POp-MODN m n) (modulo m n)) + (define (unison-POp-NTOT n) (string->chunked-string (number->string n))) + (define (unison-POp-PAKB l) + (build-chunked-bytes + (chunked-list-length l) + (lambda (i) (chunked-list-ref l i)))) + (define (unison-POp-PAKT l) + (build-chunked-string + (chunked-list-length l) + (lambda (i) (chunked-list-ref l i)))) + (define (unison-POp-SHLI i k) + (clamp-integer (arithmetic-shift i k))) + (define (unison-POp-SHLN n k) + (clamp-natural (arithmetic-shift n k))) + (define (unison-POp-SHRI i k) (arithmetic-shift i (- k))) + (define (unison-POp-SHRN n k) (arithmetic-shift n (- k))) + (define (unison-POp-SIZS l) (chunked-list-length l)) + (define (unison-POp-SIZT t) (chunked-string-length t)) + (define (unison-POp-SIZB b) (chunked-bytes-length b)) + (define (unison-POp-SNOC xs x) (chunked-list-add-last xs x)) + (define (unison-POp-SUBN m n) (clamp-integer (- m n))) + (define (unison-POp-SUBI m n) (clamp-integer (- m n))) + (define (unison-POp-TAKS n s) (chunked-list-take s n)) + (define (unison-POp-TAKT n t) (chunked-string-take t n)) + (define (unison-POp-TAKB n t) (chunked-bytes-take t n)) + + (define (->optional v) + (if v + (ref-optional-some v) + ref-optional-none)) + + (define-unison-builtin (builtin-Text.indexOf n h) + (->optional (chunked-string-index-of h n))) + (define-unison-builtin (builtin-Bytes.indexOf n h) + (->optional (chunked-bytes-index-of h n))) + + ;; TODO currently only runs in low-level tracing support + (define (unison-POp-DBTX x) + (sum 1 (string->chunked-string (describe-value x)))) + + (define (unison-FOp-Handle.toText h) + (string->chunked-string (describe-value h))) + (define (unison-FOp-Socket.toText s) + (string->chunked-string (describe-value s))) + (define (unison-FOp-ThreadId.toText tid) + (string->chunked-string (describe-value tid))) + + (define (unison-POp-TRCE s x) + (display "trace: ") + (display (chunked-string->string s)) + (newline) + (display (describe-value x)) + (newline)) + (define (unison-POp-PRNT s) + (display (chunked-string->string s)) + (newline)) + (define (unison-POp-TTON s) + (let ([mn (string->number (chunked-string->string s))]) + (if (and (exact-nonnegative-integer? mn) (< mn bit64)) + (some mn) + none))) + (define (unison-POp-TTOI s) + (let ([mn (string->number (chunked-string->string s))]) + (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) + (some mn) + none))) + (define (unison-POp-TTOF s) + (let ([mn (string->number (chunked-string->string s))]) + (if mn (some mn) none))) + (define (unison-POp-UPKT s) + (build-chunked-list + (chunked-string-length s) + (lambda (i) (chunked-string-ref s i)))) + (define (unison-POp-VWLS l) + (if (chunked-list-empty? l) + (sum 0) + (let-values ([(t h) (chunked-list-pop-first l)]) + (sum 1 h t)))) + (define (unison-POp-VWRS l) + (if (chunked-list-empty? l) + (sum 0) + (let-values ([(t h) (chunked-list-pop-last l)]) + (sum 1 t h)))) + (define (unison-POp-SPLL i s) + (if (< (chunked-list-length s) i) + (sum 0) + (let-values ([(l r) (chunked-list-split-at s i)]) + (sum 1 l r)))) + (define (unison-POp-SPLR i s) ; TODO write test that stresses this + (let ([len (chunked-list-length s) ]) + (if (< len i) + (sum 0) + (let-values ([(l r) (chunked-list-split-at s (- len i))]) + (sum 1 l r))))) + + (define (unison-POp-UCNS s) + (if (chunked-string-empty? s) + (sum 0) + (let-values ([(t h) (chunked-string-pop-first s)]) + (sum 1 (char h) t)))) + + (define (unison-POp-USNC s) + (if (chunked-string-empty? s) + (sum 0) + (let-values ([(t h) (chunked-string-pop-last s)]) + (sum 1 t (char h))))) + + ;; TODO flatten operation on Bytes is a no-op for now (and possibly ever) + (define (unison-POp-FLTB b) b) + + (define (unison-POp-XORN m n) (bitwise-xor m n)) + (define (unison-POp-VALU c) (decode-value c)) + + (define (unison-FOp-ImmutableByteArray.read16be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u16-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read24be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u24-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read32be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u32-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read40be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u40-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read48be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u48-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read56be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u56-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read64be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u64-ref bs n 'big))))) + + (define unison-FOp-internal.dataTag unison-data-tag) + + (define (unison-FOp-IO.getBytes.impl.v3 p n) + (reify-exn + (lambda () + (right + (bytes->chunked-bytes + (read-bytes n p)))))) + + (define (unison-FOp-IO.putBytes.impl.v3 p bs) + (begin + (write-bytes (chunked-bytes->bytes bs) p) + (flush-output p) + (sum 1 #f))) + + (define (unison-FOp-Char.toText c) (string->chunked-string (string (integer->char c)))) + + (define (unison-FOp-IO.getArgs.impl.v1) + (sum 1 (cdr (command-line)))) + + (define unison-FOp-IO.systemTimeMicroseconds.v1 current-microseconds) + + ;; TODO should we convert Bytes -> Text directly without the intermediate conversions? + (define (unison-FOp-Text.fromUtf8.impl.v3 b) + (with-handlers + ([exn:fail:contract? (lambda (e) - (raise-unison-exception - ref-miscfailure:typelink - (exception->string e) - ref-unit-unit))]) - (thunk ref-unit-unit))) - - (declare-builtin-link builtin-Float.*) - (declare-builtin-link builtin-Float.fromRepresentation) - (declare-builtin-link builtin-Float.toRepresentation) - (declare-builtin-link builtin-Float.ceiling) - (declare-builtin-link builtin-Float.exp) - (declare-builtin-link builtin-Float.log) - (declare-builtin-link builtin-Float.max) - (declare-builtin-link builtin-Float.min) - (declare-builtin-link builtin-Float.tan) - (declare-builtin-link builtin-Float.tanh) - (declare-builtin-link builtin-Float.logBase) - (declare-builtin-link builtin-Float.pow) - (declare-builtin-link builtin-Float.>) - (declare-builtin-link builtin-Float.<) - (declare-builtin-link builtin-Float.>=) - (declare-builtin-link builtin-Float.<=) - (declare-builtin-link builtin-Float.==) - (declare-builtin-link builtin-Int.pow) - (declare-builtin-link builtin-Int.*) - (declare-builtin-link builtin-Int.+) - (declare-builtin-link builtin-Int.-) - (declare-builtin-link builtin-Int./) - (declare-builtin-link builtin-Int.>) - (declare-builtin-link builtin-Int.<) - (declare-builtin-link builtin-Int.>=) - (declare-builtin-link builtin-Int.<=) - (declare-builtin-link builtin-Int.==) - (declare-builtin-link builtin-Int.isEven) - (declare-builtin-link builtin-Int.isOdd) - (declare-builtin-link builtin-Int.increment) - (declare-builtin-link builtin-Int.negate) - (declare-builtin-link builtin-Int.fromRepresentation) - (declare-builtin-link builtin-Int.toRepresentation) - (declare-builtin-link builtin-Int.signum) - (declare-builtin-link builtin-Int.trailingZeros) - (declare-builtin-link builtin-Int.popCount) - (declare-builtin-link builtin-Nat.increment) - (declare-builtin-link builtin-Nat.popCount) - (declare-builtin-link builtin-Nat.toFloat) - (declare-builtin-link builtin-Nat.trailingZeros) - (declare-builtin-link builtin-Nat.+) - (declare-builtin-link builtin-Nat.>) - (declare-builtin-link builtin-Nat.<) - (declare-builtin-link builtin-Nat.>=) - (declare-builtin-link builtin-Nat.<=) - (declare-builtin-link builtin-Nat.==) - (declare-builtin-link builtin-Nat.drop) - (declare-builtin-link builtin-Nat.isEven) - (declare-builtin-link builtin-Nat.isOdd) - (declare-builtin-link builtin-Text.indexOf) - (declare-builtin-link builtin-Text.>) - (declare-builtin-link builtin-Text.<) - (declare-builtin-link builtin-Text.>=) - (declare-builtin-link builtin-Text.<=) - (declare-builtin-link builtin-Text.==) - (declare-builtin-link builtin-Text.!=) - (declare-builtin-link builtin-Bytes.indexOf) - (declare-builtin-link builtin-IO.randomBytes) - (declare-builtin-link builtin-IO.tryEval) - (declare-builtin-link builtin-List.splitLeft) - (declare-builtin-link builtin-List.splitRight) - (declare-builtin-link builtin-Value.toBuiltin) - (declare-builtin-link builtin-Value.fromBuiltin) - (declare-builtin-link builtin-Code.fromGroup) - (declare-builtin-link builtin-Code.toGroup) - (declare-builtin-link builtin-TermLink.fromReferent) - (declare-builtin-link builtin-TermLink.toReferent) - (declare-builtin-link builtin-TypeLink.toReference) - (declare-builtin-link builtin-IO.seekHandle.impl.v3) - (declare-builtin-link builtin-IO.getLine.impl.v1) - (declare-builtin-link builtin-IO.getSomeBytes.impl.v1) - (declare-builtin-link builtin-IO.setBuffering.impl.v3) - (declare-builtin-link builtin-IO.getBuffering.impl.v3) - (declare-builtin-link builtin-IO.setEcho.impl.v1) - (declare-builtin-link builtin-IO.isFileOpen.impl.v3) - (declare-builtin-link builtin-IO.ready.impl.v1) - (declare-builtin-link builtin-IO.process.call) - (declare-builtin-link builtin-IO.getEcho.impl.v1) - (declare-builtin-link builtin-IO.getArgs.impl.v1) - (declare-builtin-link builtin-IO.getEnv.impl.v1) - (declare-builtin-link builtin-IO.getChar.impl.v1) - (declare-builtin-link builtin-IO.directoryContents.impl.v3) - (declare-builtin-link builtin-IO.getCurrentDirectory.impl.v3) - (declare-builtin-link builtin-IO.removeDirectory.impl.v3) - (declare-builtin-link builtin-IO.renameFile.impl.v3) - (declare-builtin-link builtin-IO.createTempDirectory.impl.v3) - (declare-builtin-link builtin-IO.createDirectory.impl.v3) - (declare-builtin-link builtin-IO.setCurrentDirectory.impl.v3) - (declare-builtin-link builtin-IO.renameDirectory.impl.v3) - (declare-builtin-link builtin-IO.fileExists.impl.v3) - (declare-builtin-link builtin-IO.isDirectory.impl.v3) - (declare-builtin-link builtin-IO.isFileEOF.impl.v3) - (declare-builtin-link builtin-IO.isSeekable.impl.v3) - (declare-builtin-link builtin-IO.handlePosition.impl.v3) - (declare-builtin-link builtin-IO.systemTime.impl.v3) - (declare-builtin-link builtin-IO.systemTimeMicroseconds.impl.v3) - (declare-builtin-link builtin-Universal.==) - (declare-builtin-link builtin-Universal.>) - (declare-builtin-link builtin-Universal.<) - (declare-builtin-link builtin-Universal.>=) - (declare-builtin-link builtin-Universal.<=) - (declare-builtin-link builtin-Universal.compare) - (declare-builtin-link builtin-Pattern.isMatch) - (declare-builtin-link builtin-Scope.bytearrayOf) - (declare-builtin-link builtin-Char.Class.is) - (declare-builtin-link builtin-Pattern.many.corrected) - (declare-builtin-link builtin-unsafe.coerceAbilities) - (declare-builtin-link builtin-Clock.internals.systemTimeZone.v1) - ) + (exception + ref-iofailure:typelink + (string->chunked-string + (string-append + "Invalid UTF-8 stream: " + (describe-value b))) + (exception->string e)))]) + (right (string->chunked-string (bytes->string/utf-8 (chunked-bytes->bytes b)))))) + + ;; TODO should we convert Text -> Bytes directly without the intermediate conversions? + (define (unison-FOp-Text.toUtf8 s) + (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) + + (define-unison-builtin (builtin-IO.isFileEOF.impl.v3 p) + (ref-either-right (eof-object? (peek-byte p)))) + + (define (unison-FOp-IO.closeFile.impl.v3 h) + (if (input-port? h) + (close-input-port h) + (close-output-port h)) + (right none)) + + (define (unison-FOp-Text.repeat n t) + (let loop ([cnt 0] + [acc empty-chunked-string]) + (if (= cnt n) + acc + (loop (+ cnt 1) (chunked-string-append acc t))))) + + (define (unison-FOp-Text.reverse s) + (chunked-string-foldMap-chunks + s + string-reverse + (lambda (acc c) (chunked-string-append c acc)))) + + (define (unison-FOp-Text.toLowercase s) + (chunked-string-foldMap-chunks s string-downcase chunked-string-append)) + + (define (unison-FOp-Text.toUppercase s) + (chunked-string-foldMap-chunks s string-upcase chunked-string-append)) + + (define (unison-FOp-Pattern.run p s) + (let* ([r (pattern-match p s)]) + (if r (sum 1 (cdr r) (car r)) (sum 0)))) + + (define (unison-FOp-Pattern.isMatch p s) (bool (pattern-match? p s))) + (define (unison-FOp-Pattern.many p) (many p)) + (define (unison-FOp-Pattern.capture p) (capture p)) + (define (unison-FOp-Pattern.join ps) + (join* ps)) + (define (unison-FOp-Pattern.or p1 p2) (choice p1 p2)) + (define (unison-FOp-Pattern.replicate n m p) (replicate p n m)) + + (define (unison-FOp-Text.patterns.digit) digit) + (define (unison-FOp-Text.patterns.letter) letter) + (define (unison-FOp-Text.patterns.punctuation) punctuation) + (define (unison-FOp-Text.patterns.charIn cs) (chars cs)) + (define (unison-FOp-Text.patterns.notCharIn cs) (not-chars cs)) + (define (unison-FOp-Text.patterns.anyChar) any-char) + (define (unison-FOp-Text.patterns.space) space) + (define (unison-FOp-Text.patterns.charRange a z) (char-range (integer->char a) (integer->char z))) + (define (unison-FOp-Text.patterns.notCharRange a z) (not-char-range (integer->char a) (integer->char z))) + (define (unison-FOp-Text.patterns.literal s) (literal s)) + (define (unison-FOp-Text.patterns.eof) eof) + (define (unison-FOp-Text.patterns.char cc) cc) + (define (unison-FOp-Char.Class.is cc c) + (unison-FOp-Pattern.isMatch cc (unison-FOp-Char.toText c))) + (define (unison-FOp-Char.Class.any) (unison-FOp-Text.patterns.anyChar)) + (define (unison-FOp-Char.Class.punctuation) + (unison-FOp-Text.patterns.punctuation)) + (define (unison-FOp-Char.Class.letter) (unison-FOp-Text.patterns.letter)) + (define (unison-FOp-Char.Class.alphanumeric) alphanumeric) + (define (unison-FOp-Char.Class.upper) upper) + (define (unison-FOp-Char.Class.lower) lower) + (define (unison-FOp-Char.Class.number) number) + (define (unison-FOp-Char.Class.symbol) symbol) + (define (unison-FOp-Char.Class.whitespace) space) + (define (unison-FOp-Char.Class.control) control) + (define (unison-FOp-Char.Class.printable) printable) + (define (unison-FOp-Char.Class.mark) mark) + (define (unison-FOp-Char.Class.separator) separator) + (define (unison-FOp-Char.Class.or p1 p2) (char-class-or p1 p2)) + (define (unison-FOp-Char.Class.range a z) + (unison-FOp-Text.patterns.charRange a z)) + (define (unison-FOp-Char.Class.anyOf cs) (unison-FOp-Text.patterns.charIn cs)) + (define (unison-FOp-Char.Class.and cc1 cc2) (char-class-and cc1 cc2)) + (define (unison-FOp-Char.Class.not cc) (char-class-not cc)) + + (define (catch-array thunk) + (reify-exn thunk)) + + (define (unison-FOp-ImmutableArray.read vec i) + (catch-array + (lambda () + (sum 1 (vector-ref vec i))))) + + (define (unison-FOp-ImmutableArray.copyTo! dst doff src soff n) + (catch-array + (lambda () + (vector-copy! dst doff src soff n) + (sum 1)))) + + (define (unison-FOp-MutableArray.copyTo! dst doff src soff l) + (catch-array + (lambda () + (vector-copy! dst doff src soff l) + (sum 1)))) + + (define unison-FOp-MutableArray.freeze! freeze-vector!) + + (define unison-FOp-MutableArray.freeze freeze-subvector) + + (define (unison-FOp-MutableArray.read src i) + (catch-array + (lambda () + (sum 1 (vector-ref src i))))) + + (define (unison-FOp-MutableArray.write dst i x) + (catch-array + (lambda () + (vector-set! dst i x) + (sum 1)))) + + (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n) + (catch-array + (lambda () + (bytes-copy! dst doff src soff n) + (sum 1)))) + + (define (unison-FOp-ImmutableByteArray.read8 arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u8-ref arr i))))) + + (define (unison-FOp-MutableByteArray.copyTo! dst doff src soff l) + (catch-array + (lambda () + (bytes-copy! dst doff src soff l) + (sum 1)))) + + (define unison-FOp-MutableByteArray.freeze! freeze-bytevector!) + + (define (unison-FOp-MutableByteArray.write8 arr i b) + (catch-array + (lambda () + (bytevector-u8-set! arr i b) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write16be arr i b) + (catch-array + (lambda () + (bytevector-u16-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write32be arr i b) + (catch-array + (lambda () + (bytevector-u32-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write64be arr i b) + (catch-array + (lambda () + (bytevector-u64-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.read8 arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u8-ref arr i))))) + + (define (unison-FOp-MutableByteArray.read16be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u16-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read24be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u24-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read32be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u32-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read40be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u40-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read64be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u64-ref arr i 'big))))) + + (define (unison-FOp-Scope.bytearray n) (make-bytes n)) + (define (unison-FOp-IO.bytearray n) (make-bytes n)) + + (define (unison-FOp-Scope.array n) (make-vector n)) + (define (unison-FOp-IO.array n) (make-vector n)) + + (define (unison-FOp-Scope.bytearrayOf b n) (make-bytes n b)) + (define (unison-FOp-IO.bytearrayOf b n) (make-bytes n b)) + + (define (unison-FOp-Scope.arrayOf v n) (make-vector n v)) + (define (unison-FOp-IO.arrayOf v n) (make-vector n v)) + + (define unison-FOp-MutableByteArray.length bytevector-length) + (define unison-FOp-ImmutableByteArray.length bytevector-length) + (define unison-FOp-MutableByteArray.size bytevector-length) + (define unison-FOp-ImmutableByteArray.size bytevector-length) + (define unison-FOp-MutableArray.size vector-length) + (define unison-FOp-ImmutableArray.size vector-length) + + (define (unison-POp-FORK thunk) (fork thunk)) + (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros)) + (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId)) + (define (unison-FOp-Scope.ref a) (ref-new a)) + (define (unison-FOp-IO.ref a) (ref-new a)) + (define (unison-FOp-Ref.read ref) (ref-read ref)) + (define (unison-FOp-Ref.write ref a) (ref-write ref a)) + (define (unison-FOp-Ref.readForCas ref) (ref-read ref)) + (define (unison-FOp-Ref.Ticket.read ticket) ticket) + (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value)) + (define (unison-FOp-Promise.new) (promise-new)) + (define (unison-FOp-Promise.read promise) (promise-read promise)) + (define (unison-FOp-Promise.tryRead promise) (promise-try-read promise)) + (define (unison-FOp-Promise.write promise a) (promise-write promise a))) + + +(define (exn:io? e) + (or (exn:fail:read? e) + (exn:fail:filesystem? e) + (exn:fail:network? e))) + +(define (exn:arith? e) + (or (exn:fail:contract:divide-by-zero? e) + (exn:fail:contract:non-fixnum-result? e))) + +(define-unison-builtin (builtin-IO.tryEval thunk) + (with-handlers + ([exn:break? + (lambda (e) + (raise-unison-exception + ref-threadkilledfailure:typelink + (string->chunked-string "thread killed") + ref-unit-unit))] + [exn:io? + (lambda (e) + (raise-unison-exception + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))] + [exn:arith? + (lambda (e) + (raise-unison-exception + ref-arithfailure:typelink + (exception->string e) + ref-unit-unit))] + [exn:bug? (lambda (e) (exn:bug->exception e))] + [exn:fail? + (lambda (e) + (raise-unison-exception + ref-runtimefailure:typelink + (exception->string e) + ref-unit-unit))] + [(lambda (x) #t) + (lambda (e) + (raise-unison-exception + ref-miscfailure:typelink + (exception->string e) + ref-unit-unit))]) + (thunk ref-unit-unit))) + +; (declare-builtin-link builtin-Float.*) +; (declare-builtin-link builtin-Float.fromRepresentation) +; (declare-builtin-link builtin-Float.toRepresentation) +; (declare-builtin-link builtin-Float.ceiling) +; (declare-builtin-link builtin-Float.exp) +; (declare-builtin-link builtin-Float.log) +; (declare-builtin-link builtin-Float.max) +; (declare-builtin-link builtin-Float.min) +; (declare-builtin-link builtin-Float.tan) +; (declare-builtin-link builtin-Float.tanh) +; (declare-builtin-link builtin-Float.logBase) +; (declare-builtin-link builtin-Float.pow) +; (declare-builtin-link builtin-Float.>) +; (declare-builtin-link builtin-Float.<) +; (declare-builtin-link builtin-Float.>=) +; (declare-builtin-link builtin-Float.<=) +; (declare-builtin-link builtin-Float.==) +; (declare-builtin-link builtin-Int.pow) +; (declare-builtin-link builtin-Int.*) +; (declare-builtin-link builtin-Int.+) +; (declare-builtin-link builtin-Int.-) +; (declare-builtin-link builtin-Int./) +; (declare-builtin-link builtin-Int.>) +; (declare-builtin-link builtin-Int.<) +; (declare-builtin-link builtin-Int.>=) +; (declare-builtin-link builtin-Int.<=) +; (declare-builtin-link builtin-Int.==) +; (declare-builtin-link builtin-Int.isEven) +; (declare-builtin-link builtin-Int.isOdd) +; (declare-builtin-link builtin-Int.increment) +; (declare-builtin-link builtin-Int.negate) +; (declare-builtin-link builtin-Int.fromRepresentation) +; (declare-builtin-link builtin-Int.toRepresentation) +; (declare-builtin-link builtin-Int.signum) +; (declare-builtin-link builtin-Int.trailingZeros) +; (declare-builtin-link builtin-Int.popCount) +; (declare-builtin-link builtin-Nat.increment) +; (declare-builtin-link builtin-Nat.popCount) +; (declare-builtin-link builtin-Nat.toFloat) +; (declare-builtin-link builtin-Nat.trailingZeros) +; (declare-builtin-link builtin-Nat.+) +; (declare-builtin-link builtin-Nat.>) +; (declare-builtin-link builtin-Nat.<) +; (declare-builtin-link builtin-Nat.>=) +; (declare-builtin-link builtin-Nat.<=) +; (declare-builtin-link builtin-Nat.==) +; (declare-builtin-link builtin-Nat.drop) +; (declare-builtin-link builtin-Nat.isEven) +; (declare-builtin-link builtin-Nat.isOdd) +; (declare-builtin-link builtin-Text.indexOf) +; (declare-builtin-link builtin-Text.>) +; (declare-builtin-link builtin-Text.<) +; (declare-builtin-link builtin-Text.>=) +; (declare-builtin-link builtin-Text.<=) +; (declare-builtin-link builtin-Text.==) +; (declare-builtin-link builtin-Text.!=) +; (declare-builtin-link builtin-Bytes.indexOf) +; (declare-builtin-link builtin-IO.randomBytes) +; (declare-builtin-link builtin-IO.tryEval) +; (declare-builtin-link builtin-List.splitLeft) +; (declare-builtin-link builtin-List.splitRight) +; (declare-builtin-link builtin-Value.toBuiltin) +; (declare-builtin-link builtin-Value.fromBuiltin) +; (declare-builtin-link builtin-Code.fromGroup) +; (declare-builtin-link builtin-Code.toGroup) +; (declare-builtin-link builtin-TermLink.fromReferent) +; (declare-builtin-link builtin-TermLink.toReferent) +; (declare-builtin-link builtin-TypeLink.toReference) +; (declare-builtin-link builtin-IO.seekHandle.impl.v3) +; (declare-builtin-link builtin-IO.getLine.impl.v1) +; (declare-builtin-link builtin-IO.getSomeBytes.impl.v1) +; (declare-builtin-link builtin-IO.setBuffering.impl.v3) +; (declare-builtin-link builtin-IO.getBuffering.impl.v3) +; (declare-builtin-link builtin-IO.setEcho.impl.v1) +; (declare-builtin-link builtin-IO.isFileOpen.impl.v3) +; (declare-builtin-link builtin-IO.ready.impl.v1) +; (declare-builtin-link builtin-IO.process.call) +; (declare-builtin-link builtin-IO.getEcho.impl.v1) +; (declare-builtin-link builtin-IO.getArgs.impl.v1) +; (declare-builtin-link builtin-IO.getEnv.impl.v1) +; (declare-builtin-link builtin-IO.getChar.impl.v1) +; (declare-builtin-link builtin-IO.directoryContents.impl.v3) +; (declare-builtin-link builtin-IO.getCurrentDirectory.impl.v3) +; (declare-builtin-link builtin-IO.removeDirectory.impl.v3) +; (declare-builtin-link builtin-IO.renameFile.impl.v3) +; (declare-builtin-link builtin-IO.createTempDirectory.impl.v3) +; (declare-builtin-link builtin-IO.createDirectory.impl.v3) +; (declare-builtin-link builtin-IO.setCurrentDirectory.impl.v3) +; (declare-builtin-link builtin-IO.renameDirectory.impl.v3) +; (declare-builtin-link builtin-IO.fileExists.impl.v3) +; (declare-builtin-link builtin-IO.isDirectory.impl.v3) +; (declare-builtin-link builtin-IO.isFileEOF.impl.v3) +; (declare-builtin-link builtin-IO.isSeekable.impl.v3) +; (declare-builtin-link builtin-IO.handlePosition.impl.v3) +; (declare-builtin-link builtin-IO.systemTime.impl.v3) +; (declare-builtin-link builtin-IO.systemTimeMicroseconds.impl.v3) +; (declare-builtin-link builtin-Universal.==) +; (declare-builtin-link builtin-Universal.>) +; (declare-builtin-link builtin-Universal.<) +; (declare-builtin-link builtin-Universal.>=) +; (declare-builtin-link builtin-Universal.<=) +; (declare-builtin-link builtin-Universal.compare) +; (declare-builtin-link builtin-Pattern.isMatch) +; (declare-builtin-link builtin-Scope.bytearrayOf) +; (declare-builtin-link builtin-Char.Class.is) +; (declare-builtin-link builtin-Pattern.many.corrected) +; (declare-builtin-link builtin-unsafe.coerceAbilities) +; (declare-builtin-link builtin-Clock.internals.systemTimeZone.v1) diff --git a/scheme-libs/racket/unison/sandbox.rkt b/scheme-libs/racket/unison/sandbox.rkt index a24c70f2f9..248d0b06e8 100644 --- a/scheme-libs/racket/unison/sandbox.rkt +++ b/scheme-libs/racket/unison/sandbox.rkt @@ -4,7 +4,7 @@ (provide expand-sandbox check-sandbox set-sandbox) (require racket racket/hash) -(require (except-in unison/data true false unit)) +(require unison/data) ; sandboxing information (define sandbox-links (make-hash)) diff --git a/scheme-libs/racket/unison/udp.rkt b/scheme-libs/racket/unison/udp.rkt index 3607673264..2f1170e01b 100644 --- a/scheme-libs/racket/unison/udp.rkt +++ b/scheme-libs/racket/unison/udp.rkt @@ -2,7 +2,7 @@ #lang racket/base (require racket/udp racket/format - (only-in unison/boot define-unison) + (only-in unison/boot define-unison-builtin) unison/data unison/data-info unison/chunked-seq @@ -11,32 +11,29 @@ unison/core) (provide - (prefix-out - builtin-IO.UDP. - (combine-out - clientSocket.impl.v1 - clientSocket.impl.v1:termlink - UDPSocket.recv.impl.v1 - UDPSocket.recv.impl.v1:termlink - UDPSocket.send.impl.v1 - UDPSocket.send.impl.v1:termlink - UDPSocket.close.impl.v1 - UDPSocket.close.impl.v1:termlink - ListenSocket.close.impl.v1 - ListenSocket.close.impl.v1:termlink - UDPSocket.toText.impl.v1 - UDPSocket.toText.impl.v1:termlink - serverSocket.impl.v1 - serverSocket.impl.v1:termlink - ListenSocket.toText.impl.v1 - ListenSocket.toText.impl.v1:termlink - ListenSocket.recvFrom.impl.v1 - ListenSocket.recvFrom.impl.v1:termlink - ClientSockAddr.toText.v1 - ClientSockAddr.toText.v1:termlink - ListenSocket.sendTo.impl.v1 - ListenSocket.sendTo.impl.v1:termlink))) - + builtin-IO.UDP.clientSocket.impl.v1 + builtin-IO.UDP.clientSocket.impl.v1:termlink + builtin-IO.UDP.UDPSocket.recv.impl.v1 + builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink + builtin-IO.UDP.UDPSocket.send.impl.v1 + builtin-IO.UDP.UDPSocket.send.impl.v1:termlink + builtin-IO.UDP.UDPSocket.close.impl.v1 + builtin-IO.UDP.UDPSocket.close.impl.v1:termlink + builtin-IO.UDP.ListenSocket.close.impl.v1 + builtin-IO.UDP.ListenSocket.close.impl.v1:termlink + builtin-IO.UDP.UDPSocket.toText.impl.v1 + builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink + builtin-IO.UDP.serverSocket.impl.v1 + builtin-IO.UDP.serverSocket.impl.v1:termlink + builtin-IO.UDP.ListenSocket.toText.impl.v1 + builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink + builtin-IO.UDP.ClientSockAddr.toText.v1 + builtin-IO.UDP.ClientSockAddr.toText.v1:termlink + builtin-IO.UDP.ListenSocket.sendTo.impl.v1 + builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink) + (struct client-sock-addr (host port)) @@ -48,10 +45,10 @@ (sum-case a (0 (type msg meta) (ref-either-left (ref-failure-failure type msg (unison-any-any meta)))) - (1 (data) + (1 (data) (ref-either-right data)))) -(define +(define (format-socket socket) (let*-values ([(local-hn local-port remote-hn remote-port) (udp-addresses socket #t)] [(rv) (~a "")]) @@ -64,7 +61,7 @@ (wrap-in-either rv))) ;; define termlink builtins -(define clientSocket.impl.v1:termlink +(define clientSocket.impl.v1:termlink (unison-termlink-builtin "IO.UDP.clientSocket.impl.v1")) (define UDPSocket.recv.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.recv.impl.v1")) @@ -72,7 +69,7 @@ (unison-termlink-builtin "IO.UDP.UDPSocket.send.impl.v1")) (define UDPSocket.close.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.close.impl.v1")) -(define ListenSocket.close.impl.v1:termlink +(define ListenSocket.close.impl.v1:termlink (unison-termlink-builtin "IO.UDP.ListenSocket.close.impl.v1")) (define UDPSocket.toText.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.toText.impl.v1")) @@ -89,22 +86,25 @@ ;; define builtins -(define-unison - (UDPSocket.recv.impl.v1 socket) ; socket -> Either Failure Bytes - (let - ([rv (handle-errors (lambda() +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.recv.impl.v1 socket) + ; socket -> Either Failure Bytes + (let + ([rv (handle-errors (lambda() (let*-values ([(buffer) (make-bytes buffer-size)] [(len a b) (udp-receive! socket buffer)]) (right (bytes->chunked-bytes (subbytes buffer 0 len))))))]) (wrap-in-either rv))) -(define-unison - (ListenSocket.close.impl.v1 socket) ; socket -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.close.impl.v1 socket) + ; socket -> Either Failure () (close-socket socket)) -(define-unison - (serverSocket.impl.v1 ip port) ; string string -> Either Failure socket +(define-unison-builtin + (builtin-IO.UDP.serverSocket.impl.v1 ip port) + ; string string -> Either Failure socket (let ([result (handle-errors (lambda() (let* ([iip (chunked-string->string ip)] @@ -115,12 +115,13 @@ (right sock)))))]) (wrap-in-either result))) -(define-unison - (ListenSocket.recvFrom.impl.v1 socket) ; socket -> Either Failure (Bytes, ClientSockAddr) - (let ([result (handle-errors (lambda() +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 socket) + ; socket -> Either Failure (Bytes, ClientSockAddr) + (let ([result (handle-errors (lambda() (if (not (udp? socket)) (raise-argument-error 'socket "a UDP socket" socket) - (let*-values + (let*-values ([(buffer) (make-bytes buffer-size)] [(len host port) (udp-receive! socket buffer)] [(csa) (client-sock-addr host port)] @@ -129,18 +130,20 @@ (right (ref-tuple-pair chunked (ref-tuple-pair csa ref-unit-unit)))))))]) (wrap-in-either result))) -(define-unison - (UDPSocket.send.impl.v1 socket data) ; socket -> Bytes -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.send.impl.v1 socket data) + ; socket -> Bytes -> Either Failure () (let ([result (handle-errors (lambda () (begin - (udp-send socket (chunked-bytes->bytes data)) + (udp-send socket (chunked-bytes->bytes data)) (right ref-unit-unit))))]) (wrap-in-either result))) -(define-unison - (ListenSocket.sendTo.impl.v1 sock bytes addr) ; socket -> Bytes -> ClientSockAddr -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.sendTo.impl.v1 sock bytes addr) + ; socket -> Bytes -> ClientSockAddr -> Either Failure () (let - ([result (handle-errors (lambda() + ([result (handle-errors (lambda() (let* ([host (client-sock-addr-host addr)] [port (client-sock-addr-port addr)] [bytes (chunked-bytes->bytes bytes)]) @@ -149,28 +152,32 @@ (right ref-unit-unit)))))]) (wrap-in-either result))) -(define-unison - (UDPSocket.toText.impl.v1 socket) ; socket -> string +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.toText.impl.v1 socket) ; socket -> string (format-socket socket)) -(define-unison - (ClientSockAddr.toText.v1 addr) ; ClientSocketAddr -> string +(define-unison-builtin + (builtin-IO.UDP.ClientSockAddr.toText.v1 addr) + ; ClientSocketAddr -> string (string->chunked-string (format "" (client-sock-addr-host addr) (client-sock-addr-port addr)))) -(define-unison - (ListenSocket.toText.impl.v1 socket) ; socket -> string +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.toText.impl.v1 socket) + ; socket -> string (format-socket socket)) -(define-unison - (UDPSocket.close.impl.v1 socket) ; socket -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.close.impl.v1 socket) + ; socket -> Either Failure () (let ([rv (handle-errors (lambda() (begin (udp-close socket) (right ref-unit-unit))))]) (wrap-in-either rv))) -(define-unison - (clientSocket.impl.v1 host port) ; string string -> Either Failure socket +(define-unison-builtin + (builtin-IO.UDP.clientSocket.impl.v1 host port) + ; string string -> Either Failure socket (let ([rv (handle-errors (lambda() (let* ([pport (string->number (chunked-string->string port))] [hhost (chunked-string->string host)] [sock (udp-open-socket hhost pport)] diff --git a/scripts/check.sh b/scripts/check.sh index 03bb6609f9..1784f69c6d 100755 --- a/scripts/check.sh +++ b/scripts/check.sh @@ -6,4 +6,5 @@ true \ && stack exec transcripts \ && stack exec unison transcript unison-src/transcripts-round-trip/main.md \ && stack exec unison transcript unison-src/transcripts-manual/rewrites.md \ + && stack exec unison transcript unison-src/transcripts-manual/docs.to-html.md \ && stack exec cli-integration-tests diff --git a/stack.yaml b/stack.yaml index ff76c60ea6..19bccd7774 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,8 @@ +## We intentionally disable Nix integration when running in a Nix shell. +notify-if-nix-on-path: false +## We pin a specific Stack version when possible. We shouldn’t then tell contributors to upgrade from there. +recommend-stack-upgrade: false + flags: haskeline: terminfo: false @@ -29,7 +34,6 @@ packages: - lib/unison-util-bytes - lib/unison-util-cache - lib/unison-util-file-embed - - lib/unison-util-nametree - lib/unison-util-relation - lib/unison-util-rope - parser-typechecker @@ -44,7 +48,7 @@ packages: - unison-syntax - yaks/easytest -resolver: lts-20.26 +resolver: lts-22.26 extra-deps: # broken version in snapshot @@ -58,15 +62,18 @@ extra-deps: commit: 9275eea7982dabbf47be2ba078ced669ae7ef3d5 # not in stackage - - fuzzyfind-3.0.1 + - fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 - guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 - lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 - - monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 - - recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 - - lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 - - lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 + - monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 + - recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 + - numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 - row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 - - network-udp-0.0.0 + - network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 + +allow-newer: true +allow-newer-deps: + - numerals ghc-options: # All packages diff --git a/stack.yaml.lock b/stack.yaml.lock index 4f98b610bf..61c24795ea 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -27,12 +27,12 @@ packages: original: url: https://github.com/unisonweb/haskeline/archive/9275eea7982dabbf47be2ba078ced669ae7ef3d5.tar.gz - completed: - hackage: fuzzyfind-3.0.1@sha256:78f89c1d79adf0a15fa2e57c693d42b4765ccfbbe380d0c9d7da6bff9f124f85,1823 + hackage: fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 pantry-tree: - sha256: 46f001ec2725d3172161c993bc8fbcf0514e3ba736f868fe2c2655e1ff49dad1 + sha256: 5bb9d39dbc4a619cf9b65409dde0d58dd488c7abab030f71ac83ba849595ee05 size: 542 original: - hackage: fuzzyfind-3.0.1 + hackage: fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 - completed: hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 pantry-tree: @@ -48,33 +48,26 @@ packages: original: hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 - completed: - hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 + hackage: monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 pantry-tree: - sha256: 8e049bd12ce2bd470909578f2ee8eb80b89d5ff88860afa30e29dd4eafecfa3e - size: 713 + sha256: 0b2a3a57be48fcc739708b214fca202f1e95b1cd773dd3bb9589d3007cf8cf5e + size: 611 original: - hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 + hackage: monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 - completed: - hackage: recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 + hackage: recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 pantry-tree: - sha256: ad6f24481ebd25a1456d5dfaf08d48d95394ce83eb82a267e01d87d34f13bb83 - size: 2488 + sha256: 59a5df9c88f83816a9826b1e9708153d06d64bd1aed6c1d71ef0a1f6db070599 + size: 2489 original: - hackage: recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 + hackage: recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 - completed: - hackage: lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 + hackage: numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 pantry-tree: - sha256: 88ea35fb71d377c035770d5f0d6a3aea51919223e3bc1e492deb6f7d9cda3a85 - size: 1043 + sha256: c616791b08f1792fd1d4ca03c6d2c773dedb25b24b66454c97864aefd85a5d0a + size: 13751 original: - hackage: lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 -- completed: - hackage: lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 - pantry-tree: - sha256: 7a3f0b679066d5e4732dfa358d76e0969589d636f4012c9e87cbe3451aa3ee5e - size: 45527 - original: - hackage: lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 + hackage: numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 - completed: hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 pantry-tree: @@ -88,10 +81,10 @@ packages: sha256: ee19a66c9d420861c5cc1dfad3210e2a53cdc6088ff3dd90b44f7961f5caebee size: 284 original: - hackage: network-udp-0.0.0 + hackage: network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 snapshots: - completed: - sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 - size: 650475 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml - original: lts-20.26 + sha256: 8e7996960d864443a66eb4105338bbdd6830377b9f6f99cd5527ef73c10c01e7 + size: 719128 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/26.yaml + original: lts-22.26 diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md index c8b10ea268..2db0994f0e 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md @@ -1,18 +1,13 @@ # Integration test: transcript ```ucm:hide -.> builtins.mergeio -.> load ./unison-src/transcripts-using-base/base.u -``` - -```ucm:hide -.> builtins.mergeio -.> load ./unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio lib.builtins +scratch/main> load ./unison-src/transcripts-using-base/base.u +scratch/main> add ``` ```unison -use .builtin +use lib.builtins unique type MyBool = MyTrue | MyFalse @@ -39,6 +34,6 @@ main = do ``` ```ucm -.> add -.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main +scratch/main> add +scratch/main> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md index c74133f4ba..92a636f2c1 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md @@ -1,7 +1,7 @@ # Integration test: transcript -```unison -use .builtin +``` unison +use lib.builtins unique type MyBool = MyTrue | MyFalse @@ -27,7 +27,7 @@ main = do _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -43,8 +43,8 @@ main = do resume : Request {g, Break} x -> x ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -53,6 +53,6 @@ main = do main : '{IO, Exception} () resume : Request {g, Break} x -> x -.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main +scratch/main> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 3402e98c92..23b18fa9d9 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -19,6 +19,7 @@ dependencies: - base - bytes - bytestring + - cmark - co-log-core - code-page - concurrent-output @@ -54,6 +55,7 @@ dependencies: - network-udp - network-uri - nonempty-containers + - numerals - open-browser - optparse-applicative >= 0.16.1.0 - pretty-simple @@ -93,7 +95,6 @@ dependencies: - unison-sqlite - unison-syntax - unison-util-base32hex - - unison-util-nametree - unison-util-relation - unliftio - unordered-containers diff --git a/unison-cli/src/ArgParse.hs b/unison-cli/src/ArgParse.hs index 5e7032942a..90ec1f9ee7 100644 --- a/unison-cli/src/ArgParse.hs +++ b/unison-cli/src/ArgParse.hs @@ -52,14 +52,19 @@ import Options.Applicative.Help (bold, (<+>)) import Options.Applicative.Help.Pretty qualified as P import Stats import System.Environment (lookupEnv) +import Text.Megaparsec qualified as Megaparsec import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathNames) +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.Types (ShouldWatchFiles (..)) +import Unison.Core.Project (ProjectAndBranch, ProjectBranchName, ProjectName) import Unison.HashQualified (HashQualified) import Unison.LSP (LspFormattingConfig (..)) import Unison.Name (Name) import Unison.Prelude import Unison.PrettyTerminal qualified as PT +import Unison.Project qualified as Project import Unison.Server.CodebaseServer (CodebaseServerOpts (..)) import Unison.Server.CodebaseServer qualified as Server import Unison.Syntax.HashQualified qualified as HQ @@ -68,7 +73,7 @@ import Unison.Util.Pretty (Width (..)) -- | Valid ways to provide source code to the run command data RunSource = RunFromPipe (HashQualified Name) - | RunFromSymbol (HashQualified Name) + | RunFromSymbol ProjectPathNames | RunFromFile FilePath (HashQualified Name) | RunCompiled FilePath deriving (Show, Eq) @@ -102,8 +107,8 @@ data Command = Launch IsHeadless CodebaseServerOpts - -- Starting path - (Maybe Path.Absolute) + -- Starting project + (Maybe (ProjectAndBranch ProjectName ProjectBranchName)) ShouldWatchFiles | PrintVersion | -- @deprecated in trunk after M2g. Remove the Init command completely after M2h has been released @@ -220,7 +225,7 @@ transcriptCommand = transcriptHelp = "Execute transcript markdown files" transcriptFooter = Just . fold . List.intersperse P.line $ - [ "For each .md file provided this executes the transcript and creates" <+> bold ".output.md" <+> "if successful.", + [ "For each .md file provided this executes the transcript and creates" <+> P.annotate bold ".output.md" <+> "if successful.", "Exits after completion, and deletes the temporary directory created, unless --save-codebase is provided", "Multiple transcript files may be provided; they are processed in sequence" <+> "starting from the same codebase." ] @@ -232,7 +237,7 @@ transcriptForkCommand = transcriptHelp = "Execute transcript markdown files in a sandboxed codebase" transcriptFooter = Just . fold . List.intersperse P.line $ - [ "For each .md file provided this executes the transcript in a sandbox codebase and creates" <+> bold ".output.md" <+> "if successful.", + [ "For each .md file provided this executes the transcript in a sandbox codebase and creates" <+> P.annotate bold ".output.md" <+> "if successful.", "Exits after completion, and deletes the temporary directory created, unless --save-codebase is provided", "Multiple transcript files may be provided; they are processed in sequence" <+> "starting from the same codebase." ] @@ -357,9 +362,9 @@ launchParser :: CodebaseServerOpts -> IsHeadless -> Parser Command launchParser envOpts isHeadless = do -- ApplicativeDo codebaseServerOpts <- codebaseServerOptsParser envOpts - startingPath <- startingPathOption + startingProject <- startingProjectOption shouldWatchFiles <- noFileWatchFlag - pure (Launch isHeadless codebaseServerOpts startingPath shouldWatchFiles) + pure (Launch isHeadless codebaseServerOpts startingProject shouldWatchFiles) initParser :: Parser Command initParser = pure Init @@ -374,9 +379,13 @@ runHQParser :: Parser (HashQualified Name) runHQParser = argument (maybeReader (HQ.parseText . Text.pack)) (metavar "SYMBOL") +runProjectPathParser :: Parser PP.ProjectPathNames +runProjectPathParser = + argument (maybeReader (eitherToMaybe . PP.parseProjectPath . Text.pack)) (metavar "@myproject/mybranch:.path.in.project") + runSymbolParser :: Parser Command runSymbolParser = - Run . RunFromSymbol <$> runHQParser <*> runArgumentParser + Run . RunFromSymbol <$> runProjectPathParser <*> runArgumentParser runFileParser :: Parser Command runFileParser = @@ -422,15 +431,15 @@ saveCodebaseToFlag = do _ -> DontSaveCodebase ) -startingPathOption :: Parser (Maybe Path.Absolute) -startingPathOption = +startingProjectOption :: Parser (Maybe (ProjectAndBranch ProjectName ProjectBranchName)) +startingProjectOption = let meta = - metavar ".path.in.codebase" - <> long "path" + metavar "project/branch" + <> long "project" <> short 'p' - <> help "Launch the UCM session at the provided path location." + <> help "Launch the UCM session at the provided project and branch." <> noGlobal - in optional $ option readAbsolutePath meta + in optional (option readProjectAndBranchNames meta) noFileWatchFlag :: Parser ShouldWatchFiles noFileWatchFlag = @@ -469,6 +478,13 @@ readPath' = do Left err -> OptParse.readerError (Text.unpack err) Right path' -> pure path' +readProjectAndBranchNames :: ReadM (ProjectAndBranch ProjectName ProjectBranchName) +readProjectAndBranchNames = do + str <- OptParse.str + case Megaparsec.parse Project.fullyQualifiedProjectAndBranchNamesParser "arg" str of + Left errBundle -> OptParse.readerError $ Megaparsec.errorBundlePretty errBundle + Right projectAndBranch -> pure projectAndBranch + fileArgument :: String -> Parser FilePath fileArgument varName = strArgument @@ -505,15 +521,15 @@ transcriptForkParser = do ) unisonHelp :: String -> String -> P.Doc -unisonHelp (P.text -> executable) (P.text -> version) = +unisonHelp (fromString -> executable) (fromString -> version) = fold . List.intersperse P.line $ - [ P.empty, + [ mempty, "🌻", - P.empty, - P.bold "Usage instructions for the Unison Codebase Manager", + mempty, + P.annotate P.bold "Usage instructions for the Unison Codebase Manager", "You are running version:" <+> version, - P.empty, - "To get started just run" <+> P.bold executable, - P.empty, - "Use" <+> P.bold (executable <+> "[command] --help") <+> "to show help for a command." + mempty, + "To get started just run" <+> P.annotate P.bold executable, + mempty, + "Use" <+> P.annotate P.bold (executable <+> "[command] --help") <+> "to show help for a command." ] diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index bb8ca79047..343ebfeeb5 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -34,7 +34,7 @@ import Unison.Sync.Types qualified as Share -- | Download a project/branch from Share. downloadProjectBranchFromShare :: - HasCallStack => + (HasCallStack) => Share.IncludeSquashedHead -> Share.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 73783e1a0f..398982889c 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -14,6 +14,7 @@ module Unison.Cli.Monad -- * Immutable state LoopState (..), loopState0, + getProjectPathIds, -- * Lifting IO actions ioE, @@ -33,6 +34,7 @@ module Unison.Cli.Monad -- * Changing the current directory cd, popd, + switchProject, -- * Communicating output to the user respond, @@ -46,38 +48,42 @@ module Unison.Cli.Monad runTransaction, runTransactionWithRollback, + -- * Internal + setMostRecentProjectPath, + -- * Misc types LoadSourceResult (..), ) where import Control.Exception (throwIO) -import Control.Lens (lens, (.=)) +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 import Data.Time.Clock (DiffTime, diffTimeToPicoseconds) import Data.Time.Clock.System (getSystemTime, systemToTAITime) import Data.Time.Clock.TAI (diffAbsoluteTime) import Data.Unique (Unique, newUnique) -import GHC.OverloadedLabels (IsLabel (..)) import System.CPUTime (getCPUTime) import Text.Printf (printf) -import U.Codebase.HashTags (CausalHash) -import U.Codebase.Sqlite.Queries qualified as Queries +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Auth.CredentialManager (CredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch) import Unison.Codebase.Editor.Input (Input) import Unison.Codebase.Editor.Output (NumberedArgs, NumberedOutput, Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) +import Unison.Core.Project (ProjectAndBranch (..)) import Unison.Debug qualified as Debug import Unison.Parser.Ann (Ann) import Unison.Prelude @@ -88,7 +94,6 @@ import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) import Unison.UnisonFile qualified as UF -import UnliftIO.STM import Unsafe.Coerce (unsafeCoerce) -- | The main command-line app monad. @@ -170,7 +175,10 @@ data Env = Env sandboxedRuntime :: Runtime Symbol, nativeRuntime :: Runtime Symbol, serverBaseUrl :: Maybe Server.BaseUrl, - ucmVersion :: UCMVersion + ucmVersion :: UCMVersion, + -- | Whether we're running in a transcript test or not. + -- Avoid using this except when absolutely necessary. + isTranscriptTest :: Bool } deriving stock (Generic) @@ -178,10 +186,8 @@ data Env = Env -- -- There's an additional pseudo @"currentPath"@ field lens, for convenience. data LoopState = LoopState - { root :: TMVar (Branch IO), - lastSavedRootHash :: CausalHash, - -- the current position in the namespace - currentPathStack :: List.NonEmpty Path.Absolute, + { -- the current position in the codebase, with the head being the most recent lcoation. + projectPathStack :: List.NonEmpty PP.ProjectPathIds, -- TBD -- , _activeEdits :: Set Branch.EditGuid @@ -206,26 +212,11 @@ data LoopState = LoopState } deriving stock (Generic) -instance - {-# OVERLAPS #-} - (Functor f) => - IsLabel "currentPath" ((Path.Absolute -> f Path.Absolute) -> (LoopState -> f LoopState)) - where - fromLabel :: (Path.Absolute -> f Path.Absolute) -> (LoopState -> f LoopState) - fromLabel = - lens - (\LoopState {currentPathStack} -> List.NonEmpty.head currentPathStack) - ( \loopState@LoopState {currentPathStack = _ List.NonEmpty.:| paths} path -> - loopState {currentPathStack = path List.NonEmpty.:| paths} - ) - -- | Create an initial loop state given a root branch and the current path. -loopState0 :: CausalHash -> TMVar (Branch IO) -> Path.Absolute -> LoopState -loopState0 lastSavedRootHash b p = do +loopState0 :: PP.ProjectPathIds -> LoopState +loopState0 p = do LoopState - { root = b, - lastSavedRootHash = lastSavedRootHash, - currentPathStack = pure p, + { projectPathStack = pure p, latestFile = Nothing, latestTypecheckedFile = Nothing, lastInput = Nothing, @@ -387,11 +378,25 @@ time label action = ms = ns / 1_000_000 s = ns / 1_000_000_000 +getProjectPathIds :: Cli PP.ProjectPathIds +getProjectPathIds = do + NonEmpty.head <$> use #projectPathStack + cd :: Path.Absolute -> Cli () cd path = do - setMostRecentNamespace path - State.modify' \state -> - state {currentPathStack = List.NonEmpty.cons path (currentPathStack state)} + pp <- getProjectPathIds + let newPP = pp & PP.absPath_ .~ path + setMostRecentProjectPath newPP + #projectPathStack %= NonEmpty.cons newPP + +switchProject :: ProjectAndBranch ProjectId ProjectBranchId -> Cli () +switchProject pab@(ProjectAndBranch projectId branchId) = do + Env {codebase} <- ask + let newPP = PP.ProjectPath projectId branchId Path.absoluteEmpty + #projectPathStack %= NonEmpty.cons newPP + runTransaction $ do Q.setMostRecentBranch projectId branchId + setMostRecentProjectPath newPP + liftIO $ Codebase.preloadProjectBranch codebase pab -- | Pop the latest path off the stack, if it's not the only path in the stack. -- @@ -399,16 +404,16 @@ cd path = do popd :: Cli Bool popd = do state <- State.get - case List.NonEmpty.uncons (currentPathStack state) of + case List.NonEmpty.uncons (projectPathStack state) of (_, Nothing) -> pure False (_, Just paths) -> do - setMostRecentNamespace (List.NonEmpty.head paths) - State.put state {currentPathStack = paths} + setMostRecentProjectPath (List.NonEmpty.head paths) + State.put state {projectPathStack = paths} pure True -setMostRecentNamespace :: Path.Absolute -> Cli () -setMostRecentNamespace = - runTransaction . Queries.setMostRecentNamespace . Path.toList . Path.unabsolute +setMostRecentProjectPath :: PP.ProjectPathIds -> Cli () +setMostRecentProjectPath loc = + runTransaction $ Codebase.setCurrentProjectPath loc respond :: Output -> Cli () respond output = do diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index a397a3b093..f9aaf22237 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -6,10 +6,18 @@ module Unison.Cli.MonadUtils -- * Paths getCurrentPath, + getCurrentProjectName, + getCurrentProjectBranchName, + getCurrentProjectPath, resolvePath, resolvePath', + resolvePath'ToAbsolute, resolveSplit', + -- * Project and branch resolution + getCurrentProjectAndBranch, + getCurrentProjectBranch, + -- * Branches -- ** Resolving branch identifiers @@ -20,18 +28,15 @@ module Unison.Cli.MonadUtils resolveShortCausalHash, -- ** Getting/setting branches - getRootBranch, - setRootBranch, - modifyRootBranch, - getRootBranch0, + getCurrentProjectRoot, + getCurrentProjectRoot0, getCurrentBranch, getCurrentBranch0, - getBranchAt, - getBranch0At, - getLastSavedRootHash, - setLastSavedRootHash, - getMaybeBranchAt, - getMaybeBranch0At, + getProjectBranchRoot, + getBranchFromProjectPath, + getBranch0FromProjectPath, + getMaybeBranchFromProjectPath, + getMaybeBranch0FromProjectPath, expectBranchAtPath, expectBranchAtPath', expectBranch0AtPath, @@ -43,13 +48,10 @@ module Unison.Cli.MonadUtils stepAt', stepAt, stepAtM, - stepAtNoSync', - stepAtNoSync, stepManyAt, - stepManyAtMNoSync, - stepManyAtNoSync, - syncRoot, - updateRoot, + stepManyAtM, + updateProjectBranchRoot, + updateProjectBranchRoot_, updateAtM, updateAt, updateAndStepAt, @@ -91,6 +93,9 @@ import U.Codebase.Branch qualified as V2 (Branch) import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) +import U.Codebase.Sqlite.Project (Project) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Codebase qualified as Codebase @@ -103,15 +108,18 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Parser.Ann (Ann (..)) import Unison.Prelude +import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Reference (TypeReference) import Unison.Referent (Referent) import Unison.Sqlite qualified as Sqlite @@ -123,7 +131,6 @@ import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UFN import Unison.Util.Set qualified as Set import Unison.Var qualified as Var -import UnliftIO.STM ------------------------------------------------------------------------------------------------------------------------ -- .unisonConfig things @@ -137,25 +144,50 @@ getConfig key = do ------------------------------------------------------------------------------------------------------------------------ -- Getting paths, path resolution, etc. --- | Get the current path. +getCurrentProjectPath :: Cli PP.ProjectPath +getCurrentProjectPath = do + ppIds <- Cli.getProjectPathIds + Cli.runTransaction $ Codebase.resolveProjectPathIds ppIds + +getCurrentProjectAndBranch :: Cli (ProjectAndBranch Project ProjectBranch) +getCurrentProjectAndBranch = do + PP.toProjectAndBranch <$> getCurrentProjectPath + +getCurrentProjectBranch :: Cli ProjectBranch +getCurrentProjectBranch = do + view #branch <$> getCurrentProjectPath + +-- | Get the current path relative to the current project. getCurrentPath :: Cli Path.Absolute getCurrentPath = do - use #currentPath + view PP.absPath_ <$> getCurrentProjectPath + +getCurrentProjectName :: Cli ProjectName +getCurrentProjectName = do + view (#project . #name) <$> getCurrentProjectPath + +getCurrentProjectBranchName :: Cli ProjectBranchName +getCurrentProjectBranchName = do + view (#branch . #name) <$> getCurrentProjectPath -- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path. -resolvePath :: Path -> Cli Path.Absolute +resolvePath :: Path -> Cli PP.ProjectPath resolvePath path = do - currentPath <- getCurrentPath - pure (Path.resolve currentPath (Path.Relative path)) + pp <- getCurrentProjectPath + pure $ pp & PP.absPath_ %~ \p -> Path.resolve p path -- | Resolve a @Path'@ to a @Path.Absolute@, per the current path. -resolvePath' :: Path' -> Cli Path.Absolute -resolvePath' path = do - currentPath <- getCurrentPath - pure (Path.resolve currentPath path) +resolvePath' :: Path' -> Cli PP.ProjectPath +resolvePath' path' = do + pp <- getCurrentProjectPath + pure $ pp & PP.absPath_ %~ \p -> Path.resolve p path' + +resolvePath'ToAbsolute :: Path' -> Cli Path.Absolute +resolvePath'ToAbsolute path' = do + view PP.absPath_ <$> resolvePath' path' -- | Resolve a path split, per the current path. -resolveSplit' :: (Path', a) -> Cli (Path.Absolute, a) +resolveSplit' :: (Path', a) -> Cli (PP.ProjectPath, a) resolveSplit' = traverseOf _1 resolvePath' @@ -166,23 +198,27 @@ resolveSplit' = -- branches by path are OK - the empty branch will be returned). resolveAbsBranchId :: Input.AbsBranchId -> Cli (Branch IO) resolveAbsBranchId = \case - Left hash -> resolveShortCausalHash hash - Right path -> getBranchAt path + Input.BranchAtSCH hash -> resolveShortCausalHash hash + Input.BranchAtPath absPath -> do + pp <- resolvePath' (Path' (Left absPath)) + getBranchFromProjectPath pp + Input.BranchAtProjectPath pp -> getBranchFromProjectPath pp -- | V2 version of 'resolveAbsBranchId2'. resolveAbsBranchIdV2 :: (forall void. Output.Output -> Sqlite.Transaction void) -> + ProjectAndBranch Project ProjectBranch -> Input.AbsBranchId -> Sqlite.Transaction (V2.Branch Sqlite.Transaction) -resolveAbsBranchIdV2 rollback = \case - Left shortHash -> do +resolveAbsBranchIdV2 rollback (ProjectAndBranch proj branch) = \case + Input.BranchAtSCH shortHash -> do hash <- resolveShortCausalHashToCausalHash rollback shortHash - succeed (Codebase.expectCausalBranchByCausalHash hash) - Right path -> succeed (Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path)) - where - succeed getCausal = do - causal <- getCausal - V2Causal.value causal + causal <- (Codebase.expectCausalBranchByCausalHash hash) + V2Causal.value causal + Input.BranchAtPath absPath -> do + let pp = PP.ProjectPath proj branch absPath + Codebase.getShallowBranchAtProjectPath pp + Input.BranchAtProjectPath pp -> Codebase.getShallowBranchAtProjectPath pp -- | Resolve a @BranchId@ to the corresponding @Branch IO@, or fail if no such branch hash is found. (Non-existent -- branches by path are OK - the empty branch will be returned). @@ -194,7 +230,7 @@ resolveBranchId branchId = do -- | Resolve a @BranchId@ to an @AbsBranchId@. resolveBranchIdToAbsBranchId :: Input.BranchId -> Cli Input.AbsBranchId resolveBranchIdToAbsBranchId = - traverseOf _Right resolvePath' + traverse (fmap (view PP.absPath_) . resolvePath') -- | Resolve a @ShortCausalHash@ to the corresponding @Branch IO@, or fail if no such branch hash is found. resolveShortCausalHash :: ShortCausalHash -> Cli (Branch IO) @@ -222,77 +258,54 @@ resolveShortCausalHashToCausalHash rollback shortHash = do -- Getting/Setting branches -- | Get the root branch. -getRootBranch :: Cli (Branch IO) -getRootBranch = do - use #root >>= atomically . readTMVar +getCurrentProjectRoot :: Cli (Branch IO) +getCurrentProjectRoot = do + Cli.Env {codebase} <- ask + ProjectAndBranch proj branch <- getCurrentProjectAndBranch + liftIO $ Codebase.expectProjectBranchRoot codebase proj.projectId branch.branchId -- | Get the root branch0. -getRootBranch0 :: Cli (Branch0 IO) -getRootBranch0 = - Branch.head <$> getRootBranch - --- | Set a new root branch. --- --- Note: This does _not_ update the codebase, the caller is responsible for that. -setRootBranch :: Branch IO -> Cli () -setRootBranch b = do - void $ modifyRootBranch (const b) - --- | Modify the root branch. --- --- Note: This does _not_ update the codebase, the caller is responsible for that. -modifyRootBranch :: (Branch IO -> Branch IO) -> Cli (Branch IO) -modifyRootBranch f = do - rootVar <- use #root - atomically do - root <- takeTMVar rootVar - let !newRoot = f root - putTMVar rootVar newRoot - pure newRoot +getCurrentProjectRoot0 :: Cli (Branch0 IO) +getCurrentProjectRoot0 = + Branch.head <$> getCurrentProjectRoot -- | Get the current branch. getCurrentBranch :: Cli (Branch IO) getCurrentBranch = do - path <- getCurrentPath Cli.Env {codebase} <- ask - liftIO $ Codebase.getBranchAtPath codebase path + pp <- getCurrentProjectPath + fromMaybe Branch.empty <$> liftIO (Codebase.getBranchAtProjectPath codebase pp) -- | Get the current branch0. getCurrentBranch0 :: Cli (Branch0 IO) getCurrentBranch0 = do Branch.head <$> getCurrentBranch --- | Get the last saved root hash. -getLastSavedRootHash :: Cli CausalHash -getLastSavedRootHash = do - use #lastSavedRootHash - --- | Set a new root branch. --- Note: This does _not_ update the codebase, the caller is responsible for that. -setLastSavedRootHash :: CausalHash -> Cli () -setLastSavedRootHash ch = do - #lastSavedRootHash .= ch - --- | Get the branch at an absolute path. -getBranchAt :: Path.Absolute -> Cli (Branch IO) -getBranchAt path = - getMaybeBranchAt path <&> fromMaybe Branch.empty +-- | Get the branch at an absolute path from the project root. +getBranchFromProjectPath :: PP.ProjectPath -> Cli (Branch IO) +getBranchFromProjectPath pp = + getMaybeBranchFromProjectPath pp <&> fromMaybe Branch.empty -- | Get the branch0 at an absolute path. -getBranch0At :: Path.Absolute -> Cli (Branch0 IO) -getBranch0At path = - Branch.head <$> getBranchAt path +getBranch0FromProjectPath :: PP.ProjectPath -> Cli (Branch0 IO) +getBranch0FromProjectPath pp = + Branch.head <$> getBranchFromProjectPath pp + +getProjectBranchRoot :: ProjectBranch -> Cli (Branch IO) +getProjectBranchRoot projectBranch = do + Cli.Env {codebase} <- ask + liftIO $ Codebase.expectProjectBranchRoot codebase projectBranch.projectId projectBranch.branchId -- | Get the maybe-branch at an absolute path. -getMaybeBranchAt :: Path.Absolute -> Cli (Maybe (Branch IO)) -getMaybeBranchAt path = do - rootBranch <- getRootBranch - pure (Branch.getAt (Path.unabsolute path) rootBranch) +getMaybeBranchFromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch IO)) +getMaybeBranchFromProjectPath pp = do + Cli.Env {codebase} <- ask + liftIO $ Codebase.getBranchAtProjectPath codebase pp -- | Get the maybe-branch0 at an absolute path. -getMaybeBranch0At :: Path.Absolute -> Cli (Maybe (Branch0 IO)) -getMaybeBranch0At path = - fmap Branch.head <$> getMaybeBranchAt path +getMaybeBranch0FromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch0 IO)) +getMaybeBranch0FromProjectPath pp = + fmap Branch.head <$> getMaybeBranchFromProjectPath pp -- | Get the branch at a relative path, or return early if there's no such branch. expectBranchAtPath :: Path -> Cli (Branch IO) @@ -303,7 +316,7 @@ expectBranchAtPath = expectBranchAtPath' :: Path' -> Cli (Branch IO) expectBranchAtPath' path0 = do path <- resolvePath' path0 - getMaybeBranchAt path & onNothingM (Cli.returnEarly (Output.BranchNotFound path0)) + getMaybeBranchFromProjectPath path & onNothingM (Cli.returnEarly (Output.BranchNotFound path0)) -- | Get the branch0 at an absolute or relative path, or return early if there's no such branch. expectBranch0AtPath' :: Path' -> Cli (Branch0 IO) @@ -329,167 +342,138 @@ assertNoBranchAtPath' path' = do -- current terms/types etc). branchExistsAtPath' :: Path' -> Cli Bool branchExistsAtPath' path' = do - absPath <- resolvePath' path' + pp <- resolvePath' path' Cli.runTransaction do - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute absPath) - branch <- V2Causal.value causal + branch <- Codebase.getShallowBranchAtProjectPath pp isEmpty <- V2Branch.isEmpty branch pure (not isEmpty) ------------------------------------------------------------------------------------------------------------------------ -- Updating branches +makeActionsUnabsolute :: (Functor f) => f (Path.Absolute, x) -> f (Path, x) +makeActionsUnabsolute = fmap (first Path.unabsolute) + stepAt :: Text -> - (Path, Branch0 IO -> Branch0 IO) -> + (ProjectPath, Branch0 IO -> Branch0 IO) -> Cli () -stepAt cause = stepManyAt @[] cause . pure +stepAt cause (pp, action) = stepManyAt pp.branch cause [(pp.absPath, action)] stepAt' :: Text -> - (Path, Branch0 IO -> Cli (Branch0 IO)) -> - Cli Bool -stepAt' cause = stepManyAt' @[] cause . pure - -stepAtNoSync' :: - (Path, Branch0 IO -> Cli (Branch0 IO)) -> + (ProjectPath, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool -stepAtNoSync' = stepManyAtNoSync' @[] . pure - -stepAtNoSync :: - (Path, Branch0 IO -> Branch0 IO) -> - Cli () -stepAtNoSync = stepManyAtNoSync @[] . pure +stepAt' cause (pp, action) = stepManyAt' pp.branch cause [(pp.absPath, action)] stepAtM :: Text -> - (Path, Branch0 IO -> IO (Branch0 IO)) -> + (ProjectPath, Branch0 IO -> IO (Branch0 IO)) -> Cli () -stepAtM cause = stepManyAtM @[] cause . pure +stepAtM cause (pp, action) = stepManyAtM pp.branch cause [(pp.absPath, action)] stepManyAt :: - (Foldable f) => + ProjectBranch -> Text -> - f (Path, Branch0 IO -> Branch0 IO) -> + [(Path.Absolute, Branch0 IO -> Branch0 IO)] -> Cli () -stepManyAt reason actions = do - stepManyAtNoSync actions - syncRoot reason +stepManyAt pb reason actions = do + updateProjectBranchRoot_ pb reason $ Branch.stepManyAt (makeActionsUnabsolute actions) stepManyAt' :: - (Foldable f) => + ProjectBranch -> Text -> - f (Path, Branch0 IO -> Cli (Branch0 IO)) -> - Cli Bool -stepManyAt' reason actions = do - res <- stepManyAtNoSync' actions - syncRoot reason - pure res - -stepManyAtNoSync' :: - (Foldable f) => - f (Path, Branch0 IO -> Cli (Branch0 IO)) -> + [(Path.Absolute, Branch0 IO -> Cli (Branch0 IO))] -> Cli Bool -stepManyAtNoSync' actions = do - origRoot <- getRootBranch - newRoot <- Branch.stepManyAtM actions origRoot - setRootBranch newRoot - pure (origRoot /= newRoot) +stepManyAt' pb reason actions = do + origRoot <- getProjectBranchRoot pb + newRoot <- Branch.stepManyAtM (makeActionsUnabsolute actions) origRoot + didChange <- updateProjectBranchRoot pb reason (\oldRoot -> pure (newRoot, oldRoot /= newRoot)) + pure didChange -- Like stepManyAt, but doesn't update the last saved root -stepManyAtNoSync :: - (Foldable f) => - f (Path, Branch0 IO -> Branch0 IO) -> - Cli () -stepManyAtNoSync actions = - void . modifyRootBranch $ Branch.stepManyAt actions - stepManyAtM :: - (Foldable f) => + ProjectBranch -> Text -> - f (Path, Branch0 IO -> IO (Branch0 IO)) -> - Cli () -stepManyAtM reason actions = do - stepManyAtMNoSync actions - syncRoot reason - -stepManyAtMNoSync :: - (Foldable f) => - f (Path, Branch0 IO -> IO (Branch0 IO)) -> + [(Path.Absolute, Branch0 IO -> IO (Branch0 IO))] -> Cli () -stepManyAtMNoSync actions = do - oldRoot <- getRootBranch - newRoot <- liftIO (Branch.stepManyAtM actions oldRoot) - setRootBranch newRoot - --- | Sync the in-memory root branch. -syncRoot :: Text -> Cli () -syncRoot description = do - rootBranch <- getRootBranch - updateRoot rootBranch description +stepManyAtM pb reason actions = do + updateProjectBranchRoot pb reason \oldRoot -> do + newRoot <- liftIO (Branch.stepManyAtM (makeActionsUnabsolute actions) oldRoot) + pure (newRoot, ()) -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise updateAtM :: Text -> - Path.Absolute -> + ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool -updateAtM reason (Path.Absolute p) f = do - b <- getRootBranch - b' <- Branch.modifyAtM p f b - updateRoot b' reason - pure $ b /= b' +updateAtM reason pp f = do + oldRootBranch <- getProjectBranchRoot (pp ^. #branch) + newRootBranch <- Branch.modifyAtM (pp ^. PP.path_) f oldRootBranch + updateProjectBranchRoot_ (pp ^. #branch) reason (const newRootBranch) + pure $ oldRootBranch /= newRootBranch -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise updateAt :: Text -> - Path.Absolute -> + ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool -updateAt reason p f = do - updateAtM reason p (pure . f) +updateAt reason pp f = do + updateAtM reason pp (pure . f) updateAndStepAt :: - (Foldable f, Foldable g) => + (Foldable f, Foldable g, Functor g) => Text -> + ProjectBranch -> f (Path.Absolute, Branch IO -> Branch IO) -> - g (Path, Branch0 IO -> Branch0 IO) -> + g (Path.Absolute, Branch0 IO -> Branch0 IO) -> Cli () -updateAndStepAt reason updates steps = do - root <- - (Branch.stepManyAt steps) - . (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) - <$> getRootBranch - updateRoot root reason - -updateRoot :: Branch IO -> Text -> Cli () -updateRoot new reason = - Cli.time "updateRoot" do - Cli.Env {codebase} <- ask - let newHash = Branch.headHash new - oldHash <- getLastSavedRootHash - when (oldHash /= newHash) do - liftIO (Codebase.putRootBranch codebase reason new) - setRootBranch new - setLastSavedRootHash newHash +updateAndStepAt reason projectBranch updates steps = do + let f b = + b + & (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) + & (Branch.stepManyAt (first Path.unabsolute <$> steps)) + updateProjectBranchRoot_ projectBranch reason f + +updateProjectBranchRoot :: ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r +updateProjectBranchRoot projectBranch reason f = do + Cli.Env {codebase} <- ask + Cli.time "updateProjectBranchRoot" do + old <- getProjectBranchRoot projectBranch + (new, result) <- f old + when (old /= new) do + liftIO $ Codebase.putBranch codebase new + Cli.runTransaction $ do + -- TODO: If we transactionally check that the project branch hasn't changed while we were computing the new + -- branch, and if it has, abort the transaction and return an error, then we can + -- remove the single UCM per codebase restriction. + causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) + Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId + pure result + +updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli () +updateProjectBranchRoot_ projectBranch reason f = do + updateProjectBranchRoot projectBranch reason (\b -> pure (f b, ())) ------------------------------------------------------------------------------------------------------------------------ -- Getting terms -getTermsAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set Referent) -getTermsAt path = do - rootBranch0 <- getRootBranch0 - pure (BranchUtil.getTerm (first Path.unabsolute path) rootBranch0) +getTermsAt :: (PP.ProjectPath, HQ'.HQSegment) -> Cli (Set Referent) +getTermsAt (pp, hqSeg) = do + rootBranch0 <- getBranch0FromProjectPath pp + pure (BranchUtil.getTerm (mempty, hqSeg) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ -- Getting types -getTypesAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set TypeReference) -getTypesAt path = do - rootBranch0 <- getRootBranch0 - pure (BranchUtil.getType (first Path.unabsolute path) rootBranch0) +getTypesAt :: (PP.ProjectPath, HQ'.HQSegment) -> Cli (Set TypeReference) +getTypesAt (pp, hqSeg) = do + rootBranch0 <- getBranch0FromProjectPath pp + pure (BranchUtil.getType (mempty, hqSeg) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ -- Getting patches @@ -507,8 +491,8 @@ getPatchAt path = -- | Get the patch at a path. getMaybePatchAt :: Path.Split' -> Cli (Maybe Patch) getMaybePatchAt path0 = do - (path, name) <- resolveSplit' path0 - branch <- getBranch0At path + (pp, name) <- resolveSplit' path0 + branch <- getBranch0FromProjectPath pp liftIO (Branch.getMaybePatch name branch) ------------------------------------------------------------------------------------------------------------------------ diff --git a/unison-cli/src/Unison/Cli/NamesUtils.hs b/unison-cli/src/Unison/Cli/NamesUtils.hs index 8e36020459..889e055bdf 100644 --- a/unison-cli/src/Unison/Cli/NamesUtils.hs +++ b/unison-cli/src/Unison/Cli/NamesUtils.hs @@ -1,15 +1,27 @@ -- | Utilities that have to do with constructing names objects. module Unison.Cli.NamesUtils ( currentNames, + currentProjectRootNames, + projectBranchNames, ) where +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import Unison.Cli.Monad (Cli) -import Unison.Cli.MonadUtils (getCurrentBranch0) +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Names (Names) -- | Produce a 'Names' object which contains names for the current branch. currentNames :: Cli Names currentNames = do - Branch.toNames <$> getCurrentBranch0 + Branch.toNames <$> Cli.getCurrentBranch0 + +currentProjectRootNames :: Cli Names +currentProjectRootNames = do + Branch.toNames <$> Cli.getCurrentProjectRoot0 + +projectBranchNames :: ProjectBranch -> Cli Names +projectBranchNames pb = do + Branch.toNames . Branch.head <$> Cli.getProjectBranchRoot pb diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index a336d860d2..07a67d1c63 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -5,7 +5,8 @@ module Unison.Cli.Pretty ( displayBranchHash, prettyAbsolute, - prettyAbsoluteStripProject, + prettyProjectPath, + prettyBranchRelativePath, prettyBase32Hex#, prettyBase32Hex, prettyBranchId, @@ -33,7 +34,6 @@ module Unison.Cli.Pretty prettyRepoInfo, prettySCH, prettySemver, - prettyShareLink, prettySharePath, prettyShareURI, prettySlashProjectBranchName, @@ -57,12 +57,10 @@ import Control.Monad.Writer (Writer, runWriter) import Data.List qualified as List import Data.Map qualified as Map import Data.Set qualified as Set -import Data.Text qualified as Text import Data.Time (UTCTime) import Data.Time.Format.Human (HumanTimeLocale (..), defaultHumanTimeLocale, humanReadableTimeI18N') import Network.URI (URI) import Network.URI qualified as URI -import Network.URI.Encode qualified as URI import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Project qualified as Sqlite @@ -70,23 +68,20 @@ import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Util.Base32Hex (Base32Hex) import U.Util.Base32Hex qualified as Base32Hex import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..)) -import Unison.Cli.ProjectUtils (projectBranchPathPrism) import Unison.Cli.Share.Projects.Types qualified as Share import Unison.Codebase.Editor.DisplayObject (DisplayObject (BuiltinObject, MissingObject, UserObject)) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.RemoteRepo ( ReadRemoteNamespace (..), - ShareUserHandle (..), - WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), - shareUserHandleToText, ) import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo -import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.CommandLine.BranchRelativePath (BranchRelativePath) import Unison.Core.Project (ProjectBranchName) import Unison.DataDeclaration qualified as DD import Unison.Debug qualified as Debug @@ -94,7 +89,7 @@ import Unison.Hash qualified as Hash import Unison.Hash32 (Hash32) import Unison.Hash32 qualified as Hash32 import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency as LD import Unison.Name (Name) import Unison.Name qualified as Name @@ -111,7 +106,7 @@ import Unison.Reference (Reference, TermReferenceId) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Server.SearchResult' qualified as SR' +import Unison.Server.SearchResultPrime qualified as SR' import Unison.ShortHash (ShortHash) import Unison.Symbol (Symbol) import Unison.Sync.Types qualified as Share @@ -126,6 +121,7 @@ import Unison.Term (Term) import Unison.Type (Type) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Monoid qualified as Monoid import Unison.Util.Pretty qualified as P import Unison.Var (Var) import Unison.Var qualified as Var @@ -150,7 +146,7 @@ prettyReadRemoteNamespaceWith :: (a -> Text) -> ReadRemoteNamespace a -> Pretty prettyReadRemoteNamespaceWith printProject = P.group . P.blue . P.text . RemoteRepo.printReadRemoteNamespace printProject -prettyWriteRemoteNamespace :: WriteRemoteNamespace (ProjectAndBranch ProjectName ProjectBranchName) -> Pretty +prettyWriteRemoteNamespace :: (ProjectAndBranch ProjectName ProjectBranchName) -> Pretty prettyWriteRemoteNamespace = P.group . P.blue . P.text . RemoteRepo.printWriteRemoteNamespace @@ -161,14 +157,6 @@ prettyRepoInfo :: Share.RepoInfo -> Pretty prettyRepoInfo (Share.RepoInfo repoInfo) = P.blue (P.text repoInfo) -prettyShareLink :: WriteShareRemoteNamespace -> Pretty -prettyShareLink WriteShareRemoteNamespace {repo, path} = - let encodedPath = - Path.toList path - & fmap (URI.encodeText . NameSegment.toUnescapedText) - & Text.intercalate "/" - in P.green . P.text $ shareOrigin <> "/@" <> shareUserHandleToText repo <> "/p/code/latest/namespaces/" <> encodedPath - prettySharePath :: Share.Path -> Pretty prettySharePath = prettyRelative @@ -194,16 +182,17 @@ prettyPath' p' = then "the current namespace" else P.blue (P.shown p') -prettyNamespaceKey :: Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Pretty +prettyNamespaceKey :: Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Pretty prettyNamespaceKey = \case - Left path -> prettyPath' path + Left path -> prettyProjectPath path Right (ProjectAndBranch project branch) -> prettyProjectAndBranchName (ProjectAndBranch (project ^. #name) (branch ^. #name)) prettyBranchId :: Input.AbsBranchId -> Pretty prettyBranchId = \case - Left sch -> prettySCH sch - Right absPath -> prettyAbsolute $ absPath + Input.BranchAtSCH sch -> prettySCH sch + Input.BranchAtPath absPath -> prettyAbsolute $ absPath + Input.BranchAtProjectPath pp -> prettyProjectPath pp prettyRelative :: Path.Relative -> Pretty prettyRelative = P.blue . P.shown @@ -211,6 +200,13 @@ prettyRelative = P.blue . P.shown prettyAbsolute :: Path.Absolute -> Pretty prettyAbsolute = P.blue . P.shown +prettyProjectPath :: PP.ProjectPath -> Pretty +prettyProjectPath (PP.ProjectPath project branch path) = + prettyProjectAndBranchName (ProjectAndBranch project.name branch.name) + <> + -- Only show the path if it's not the root + Monoid.whenM (path /= Path.absoluteEmpty) (P.cyan (":" <> P.shown path)) + prettySCH :: (IsString s) => ShortCausalHash -> P.Pretty s prettySCH hash = P.group $ "#" <> P.text (SCH.toText hash) @@ -271,6 +267,9 @@ prettyProjectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName -> prettyProjectAndBranchName (ProjectAndBranch project branch) = P.group (prettyProjectName project <> P.hiBlack "/" <> prettyProjectBranchName branch) +prettyBranchRelativePath :: BranchRelativePath -> Pretty +prettyBranchRelativePath = P.blue . P.text . into @Text + -- produces: -- -- #5v5UtREE1fTiyTsTK2zJ1YNqfiF25SkfUnnji86Lms#0 -- Optional.None, Maybe.Nothing : Maybe a @@ -343,7 +342,7 @@ prettyTypeName ppe r = prettyWhichBranchEmpty :: WhichBranchEmpty -> Pretty prettyWhichBranchEmpty = \case WhichBranchEmptyHash hash -> P.shown hash - WhichBranchEmptyPath path -> prettyPath' path + WhichBranchEmptyPath pp -> prettyProjectPath pp -- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef displayBranchHash :: CausalHash -> Text @@ -389,15 +388,6 @@ prettyRemoteBranchInfo (host, remoteProject, remoteBranch) = <> " on " <> P.shown host -stripProjectBranchInfo :: Path.Absolute -> Maybe Path.Path -stripProjectBranchInfo = fmap snd . preview projectBranchPathPrism - -prettyAbsoluteStripProject :: Path.Absolute -> Pretty -prettyAbsoluteStripProject path = - P.blue case stripProjectBranchInfo path of - Just p -> P.shown p - Nothing -> P.shown path - prettyLabeledDependencies :: PPE.PrettyPrintEnv -> Set LabeledDependency -> Pretty prettyLabeledDependencies ppe lds = P.syntaxToColor (P.sep ", " (ld <$> toList lds)) diff --git a/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs b/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs index 17abdd49c5..8ee18756f4 100644 --- a/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs +++ b/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs @@ -3,9 +3,11 @@ module Unison.Cli.PrettyPrintUtils ( prettyPrintEnvDeclFromNames, currentPrettyPrintEnvDecl, + projectBranchPPED, ) where +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.NamesUtils qualified as Cli @@ -14,6 +16,7 @@ import Unison.Names (Names) import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo) +import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED -- | Builds a pretty print env decl from a names object. @@ -30,3 +33,7 @@ prettyPrintEnvDeclFromNames ns = currentPrettyPrintEnvDecl :: Cli PPE.PrettyPrintEnvDecl currentPrettyPrintEnvDecl = do Cli.currentNames >>= prettyPrintEnvDeclFromNames + +projectBranchPPED :: ProjectBranch -> Cli PPED.PrettyPrintEnvDecl +projectBranchPPED pb = do + Cli.projectBranchNames pb >>= prettyPrintEnvDeclFromNames diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index f1ae7dd7d1..4f196c1b61 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -1,21 +1,10 @@ -- | Project-related utilities. module Unison.Cli.ProjectUtils ( -- * Project/path helpers - getCurrentProject, - expectCurrentProject, - expectCurrentProjectIds, - getCurrentProjectIds, - getCurrentProjectBranch, - getProjectBranchForPath, - expectCurrentProjectBranch, expectProjectBranchByName, - projectPath, - projectBranchesPath, - projectBranchPath, - projectBranchSegment, - projectBranchPathPrism, resolveBranchRelativePath, - branchRelativePathToAbsolute, + resolveProjectBranch, + resolveProjectBranchInProject, -- * Name hydration hydrateNames, @@ -23,9 +12,8 @@ module Unison.Cli.ProjectUtils -- * Loading local project info expectProjectAndBranchByIds, getProjectAndBranchByTheseNames, - expectProjectAndBranchByTheseNames, getProjectAndBranchByNames, - expectLooseCodeOrProjectBranch, + expectProjectAndBranchByTheseNames, getProjectBranchCausalHash, -- * Loading remote project info @@ -59,65 +47,43 @@ import Data.Maybe (fromJust) import Data.Set qualified as Set import Data.Text qualified as Text import Data.These (These (..)) -import U.Codebase.Causal qualified import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId +import U.Codebase.Sqlite.Project (Project) import U.Codebase.Sqlite.Project qualified as Sqlite +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Share.Projects (IncludeSquashedHead) import Unison.Cli.Share.Projects qualified as Share -import Unison.Codebase qualified as Codebase -import Unison.Codebase.Editor.Input (LooseCodeOrProject) import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist)) import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path -import Unison.CommandLine.BranchRelativePath (BranchRelativePath, ResolvedBranchRelativePath) -import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath +import Unison.Codebase.ProjectPath qualified as PP +import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) import Unison.Core.Project (ProjectBranchName (..)) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectName) -import Unison.Project.Util import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) -branchRelativePathToAbsolute :: BranchRelativePath -> Cli Path.Absolute -branchRelativePathToAbsolute brp = - resolveBranchRelativePath brp <&> \case - BranchRelativePath.ResolvedLoosePath p -> p - BranchRelativePath.ResolvedBranchRelative projectBranch mRel -> - let projectBranchIds = getIds projectBranch - handleRel = case mRel of - Nothing -> id - Just rel -> flip Path.resolve rel - in handleRel (projectBranchPath projectBranchIds) - where - getIds = \case - ProjectAndBranch project branch -> ProjectAndBranch (view #projectId project) (view #branchId branch) - -resolveBranchRelativePath :: BranchRelativePath -> Cli ResolvedBranchRelativePath -resolveBranchRelativePath = \case - BranchRelativePath.BranchRelative brp -> case brp of - This projectBranch -> do - projectBranch <- expectProjectAndBranchByTheseNames (toThese projectBranch) - pure (BranchRelativePath.ResolvedBranchRelative projectBranch Nothing) - That path -> do - (projectBranch, _) <- expectCurrentProjectBranch - pure (BranchRelativePath.ResolvedBranchRelative projectBranch (Just path)) - These projectBranch path -> do - projectBranch <- expectProjectAndBranchByTheseNames (toThese projectBranch) - pure (BranchRelativePath.ResolvedBranchRelative projectBranch (Just path)) - BranchRelativePath.LoosePath path -> - BranchRelativePath.ResolvedLoosePath <$> Cli.resolvePath' path - where - toThese = \case - Left branchName -> That branchName - Right (projectName, branchName) -> These projectName branchName +resolveBranchRelativePath :: BranchRelativePath -> Cli PP.ProjectPath +resolveBranchRelativePath brp = do + case brp of + BranchPathInCurrentProject projBranchName path -> do + projectAndBranch <- expectProjectAndBranchByTheseNames (That projBranchName) + pure $ PP.fromProjectAndBranch projectAndBranch path + QualifiedBranchPath projName projBranchName path -> do + projectAndBranch <- expectProjectAndBranchByTheseNames (These projName projBranchName) + pure $ PP.fromProjectAndBranch projectAndBranch path + UnqualifiedPath newPath' -> do + pp <- Cli.getCurrentProjectPath + pure $ pp & PP.absPath_ %~ \curPath -> Path.resolve curPath newPath' justTheIds :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId justTheIds x = @@ -152,58 +118,11 @@ findTemporaryBranchName projectId preferred = do pure (fromJust (List.find (\name -> not (Set.member name allBranchNames)) allCandidates)) --- | Get the current project that a user is on. -getCurrentProject :: Cli (Maybe Sqlite.Project) -getCurrentProject = do - path <- Cli.getCurrentPath - case preview projectBranchPathPrism path of - Nothing -> pure Nothing - Just (ProjectAndBranch projectId _branchId, _restPath) -> - Cli.runTransaction do - project <- Queries.expectProject projectId - pure (Just project) - --- | Like 'getCurrentProject', but fails with a message if the user is not on a project branch. -expectCurrentProject :: Cli Sqlite.Project -expectCurrentProject = do - getCurrentProject & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) - --- | Get the current project ids that a user is on. -getCurrentProjectIds :: Cli (Maybe (ProjectAndBranch ProjectId ProjectBranchId)) -getCurrentProjectIds = - fmap fst . preview projectBranchPathPrism <$> Cli.getCurrentPath - --- | Like 'getCurrentProjectIds', but fails with a message if the user is not on a project branch. -expectCurrentProjectIds :: Cli (ProjectAndBranch ProjectId ProjectBranchId) -expectCurrentProjectIds = - getCurrentProjectIds & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) - --- | Get the current project+branch+branch path that a user is on. -getCurrentProjectBranch :: Cli (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path.Path)) -getCurrentProjectBranch = do - path <- Cli.getCurrentPath - getProjectBranchForPath path - expectProjectBranchByName :: Sqlite.Project -> ProjectBranchName -> Cli Sqlite.ProjectBranch expectProjectBranchByName project branchName = Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) -getProjectBranchForPath :: Path.Absolute -> Cli (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path.Path)) -getProjectBranchForPath path = do - case preview projectBranchPathPrism path of - Nothing -> pure Nothing - Just (ProjectAndBranch projectId branchId, restPath) -> - Cli.runTransaction do - project <- Queries.expectProject projectId - branch <- Queries.expectProjectBranch projectId branchId - pure (Just (ProjectAndBranch project branch, restPath)) - --- | Like 'getCurrentProjectBranch', but fails with a message if the user is not on a project branch. -expectCurrentProjectBranch :: Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path.Path) -expectCurrentProjectBranch = - getCurrentProjectBranch & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) - -- We often accept a `These ProjectName ProjectBranchName` from the user, so they can leave off either a project or -- branch name, which we infer. This helper "hydrates" such a type to a `(ProjectName, BranchName)`, using the following -- defaults if a name is missing: @@ -214,8 +133,8 @@ hydrateNames :: These ProjectName ProjectBranchName -> Cli (ProjectAndBranch Pro hydrateNames = \case This projectName -> pure (ProjectAndBranch projectName (unsafeFrom @Text "main")) That branchName -> do - (ProjectAndBranch project _branch, _restPath) <- expectCurrentProjectBranch - pure (ProjectAndBranch (project ^. #name) branchName) + pp <- Cli.getCurrentProjectPath + pure (ProjectAndBranch (pp ^. #project . #name) branchName) These projectName branchName -> pure (ProjectAndBranch projectName branchName) getProjectAndBranchByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) @@ -244,11 +163,15 @@ getProjectAndBranchByTheseNames :: getProjectAndBranchByTheseNames = \case This projectName -> getProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> runMaybeT do - (ProjectAndBranch project _branch, _restPath) <- MaybeT getCurrentProjectBranch - branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName)) - pure (ProjectAndBranch project branch) - These projectName branchName -> - Cli.runTransaction (getProjectAndBranchByNames (ProjectAndBranch projectName branchName)) + (PP.ProjectPath proj _branch _path) <- lift Cli.getCurrentProjectPath + branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (proj ^. #projectId) branchName)) + pure (ProjectAndBranch proj branch) + These projectName branchName -> do + Cli.runTransaction do + runMaybeT do + project <- MaybeT (Queries.loadProjectByName projectName) + branch <- MaybeT (Queries.loadProjectBranchByName (project ^. #projectId) branchName) + pure (ProjectAndBranch project branch) -- Expect a local project branch by a "these names", using the following defaults if a name is missing: -- @@ -260,7 +183,7 @@ expectProjectAndBranchByTheseNames :: expectProjectAndBranchByTheseNames = \case This projectName -> expectProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> do - (ProjectAndBranch project _branch, _restPath) <- expectCurrentProjectBranch + PP.ProjectPath project _branch _restPath <- Cli.getCurrentProjectPath branch <- Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) @@ -275,31 +198,33 @@ expectProjectAndBranchByTheseNames = \case maybeProjectAndBranch & onNothing do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) --- | Expect/resolve a possibly-ambiguous "loose code or project", with the following rules: +-- | Expect/resolve branch reference with the following rules: -- --- 1. If we have an unambiguous `/branch` or `project/branch`, look up in the database. --- 2. If we have an unambiguous `loose.code.path`, just return it. --- 3. If we have an ambiguous `foo`, *because we do not currently have an unambiguous syntax for relative paths*, --- we elect to treat it as a loose code path (because `/branch` can be selected with a leading forward slash). -expectLooseCodeOrProjectBranch :: - These Path' (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> - Cli (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -expectLooseCodeOrProjectBranch = - _Right expectProjectAndBranchByTheseNames . f - where - f :: LooseCodeOrProject -> Either Path' (These ProjectName ProjectBranchName) -- (Maybe ProjectName, ProjectBranchName) - f = \case - This path -> Left path - That (ProjectAndBranch Nothing branch) -> Right (That branch) - That (ProjectAndBranch (Just project) branch) -> Right (These project branch) - These path _ -> Left path -- (3) above +-- 1. If the project is missing, use the provided project. +-- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the provided +-- project, defaulting to 'main' if branch is unspecified. +resolveProjectBranchInProject :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) +resolveProjectBranchInProject defaultProj (ProjectAndBranch mayProjectName mayBranchName) = do + let branchName = fromMaybe (unsafeFrom @Text "main") mayBranchName + let projectName = fromMaybe (defaultProj ^. #name) mayProjectName + projectAndBranch <- expectProjectAndBranchByTheseNames (These projectName branchName) + pure projectAndBranch + +-- | Expect/resolve branch reference with the following rules: +-- +-- 1. If the project is missing, use the current project. +-- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the current +-- project, defaulting to 'main' if branch is unspecified. +resolveProjectBranch :: ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) +resolveProjectBranch pab = do + pp <- Cli.getCurrentProjectPath + resolveProjectBranchInProject (pp ^. #project) pab -- | Get the causal hash of a project branch. -getProjectBranchCausalHash :: ProjectAndBranch ProjectId ProjectBranchId -> Transaction CausalHash -getProjectBranchCausalHash branch = do - let path = projectBranchPath branch - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path) - pure causal.causalHash +getProjectBranchCausalHash :: ProjectBranch -> Transaction CausalHash +getProjectBranchCausalHash ProjectBranch {projectId, branchId} = do + causalHashId <- Q.expectProjectBranchHead projectId branchId + Q.expectCausalHash causalHashId ------------------------------------------------------------------------------------------------------------------------ -- Remote project utils @@ -384,7 +309,7 @@ expectRemoteProjectBranchByTheseNames includeSquashed = \case let remoteBranchName = unsafeFrom @Text "main" expectRemoteProjectBranchByName includeSquashed (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) That branchName -> do - (ProjectAndBranch localProject localBranch, _restPath) <- expectCurrentProjectBranch + PP.ProjectPath localProject localBranch _restPath <- Cli.getCurrentProjectPath let localProjectId = localProject ^. #projectId let localBranchId = localBranch ^. #branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case diff --git a/unison-cli/src/Unison/Cli/ServantClientUtils.hs b/unison-cli/src/Unison/Cli/ServantClientUtils.hs index af6723fec1..8b22b26f3d 100644 --- a/unison-cli/src/Unison/Cli/ServantClientUtils.hs +++ b/unison-cli/src/Unison/Cli/ServantClientUtils.hs @@ -25,11 +25,11 @@ classifyConnectionError exception0 = HttpClient.ConnectionFailure exception1 -> do ioException <- fromException @IOException exception1 if - | -- This may not be 100% accurate... but if the initial `getAddrInfo` request fails it will indeed throw - -- a "does not exist" error. It seems in order to *know* that `getAddrInfo` was the cause of this - -- exception, we'd have to parse the `show` output, which is preposterous. - isDoesNotExistError ioException -> - Just ConnectionError'Offline - | otherwise -> Nothing + | -- This may not be 100% accurate... but if the initial `getAddrInfo` request fails it will indeed throw + -- a "does not exist" error. It seems in order to *know* that `getAddrInfo` was the cause of this + -- exception, we'd have to parse the `show` output, which is preposterous. + isDoesNotExistError ioException -> + Just ConnectionError'Offline + | otherwise -> Nothing _ -> Nothing _ -> ConnectionError'SomethingEntirelyUnexpected exception0 diff --git a/unison-cli/src/Unison/Cli/Share/Projects.hs b/unison-cli/src/Unison/Cli/Share/Projects.hs index 961ed69858..52fbc56e8e 100644 --- a/unison-cli/src/Unison/Cli/Share/Projects.hs +++ b/unison-cli/src/Unison/Cli/Share/Projects.hs @@ -258,8 +258,10 @@ servantClientToCli action = do (mkClientEnv httpManager hardCodedBaseUrl) { Servant.makeClientRequest = \url request -> (Servant.defaultMakeClientRequest url request) - { Http.Client.responseTimeout = Http.Client.responseTimeoutMicro (60 * 1000 * 1000 {- 60s -}) - } + <&> \req -> + req + { Http.Client.responseTimeout = Http.Client.responseTimeoutMicro (60 * 1000 * 1000 {- 60s -}) + } } liftIO (runClientM action clientEnv) diff --git a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs index 21aa566256..8ed07da067 100644 --- a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs +++ b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs @@ -5,37 +5,26 @@ module Unison.Cli.UniqueTypeGuidLookup ) where -import Control.Lens (unsnoc) -import Data.Foldable qualified as Foldable -import Data.Maybe (fromJust) import U.Codebase.Branch qualified as Codebase.Branch -import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.UniqueTypeGuidLookup qualified as Codebase import Unison.Name (Name) -import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Sqlite qualified as Sqlite -loadUniqueTypeGuid :: Path.Absolute -> Name -> Sqlite.Transaction (Maybe Text) -loadUniqueTypeGuid currentPath name0 = do - -- First, resolve the current path and the (probably/hopefully relative) name of the unique type to the full path - -- to the unique type, plus its final distinguished name segment. - let (branchPath, name) = - name0 - & Path.fromName' - & Path.resolve currentPath - & Path.unabsolute - & Path.toSeq - & unsnoc - -- This is safe because we were handed a Name, which can't be empty - & fromJust +loadUniqueTypeGuid :: ProjectPath -> Name -> Sqlite.Transaction (Maybe Text) +loadUniqueTypeGuid pp name0 = do + let (namePath, finalSegment) = Path.splitFromName name0 + let fullPP = pp & over PP.path_ (<> namePath) -- Define an operation to load a branch by its full path from the root namespace. -- -- This ought to probably lean somewhat on a cache (so long as the caller is aware of the cache, and discrads it at -- an appropriate time, such as after the current unison file finishes parsing). - let loadBranchAtPath :: [NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction)) - loadBranchAtPath = Operations.loadBranchAtPath Nothing + let loadBranchAtPath :: ProjectPath -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction)) + loadBranchAtPath = Codebase.getMaybeShallowBranchAtProjectPath - Codebase.loadUniqueTypeGuid loadBranchAtPath (Foldable.toList @Seq branchPath) name + Codebase.loadUniqueTypeGuid loadBranchAtPath fullPP finalSegment diff --git a/unison-cli/src/Unison/Cli/UnisonConfigUtils.hs b/unison-cli/src/Unison/Cli/UnisonConfigUtils.hs deleted file mode 100644 index c062c7b476..0000000000 --- a/unison-cli/src/Unison/Cli/UnisonConfigUtils.hs +++ /dev/null @@ -1,90 +0,0 @@ --- | @.unisonConfig@ file utilities -module Unison.Cli.UnisonConfigUtils - ( remoteMappingKey, - resolveConfiguredUrl, - ) -where - -import Control.Lens -import Data.Foldable.Extra qualified as Foldable -import Data.Sequence (Seq (..)) -import Data.Sequence qualified as Seq -import Data.Text qualified as Text -import Text.Megaparsec qualified as P -import Unison.Cli.Monad (Cli) -import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli -import Unison.Codebase.Editor.Output -import Unison.Codebase.Editor.Output.PushPull (PushPull) -import Unison.Codebase.Editor.RemoteRepo (WriteRemoteNamespace (..)) -import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo -import Unison.Codebase.Editor.UriParser qualified as UriParser -import Unison.Codebase.Path (Path' (..)) -import Unison.Codebase.Path qualified as Path -import Unison.Prelude -import Unison.Syntax.NameSegment qualified as NameSegment - -configKey :: Text -> Path.Absolute -> Text -configKey k p = - Text.intercalate "." . toList $ - k - :<| fmap - NameSegment.toEscapedText - (Path.toSeq $ Path.unabsolute p) - -remoteMappingKey :: Path.Absolute -> Text -remoteMappingKey = configKey "RemoteMapping" - --- Takes a maybe (namespace address triple); returns it as-is if `Just`; --- otherwise, tries to load a value from .unisonConfig, and complains --- if needed. -resolveConfiguredUrl :: PushPull -> Path' -> Cli (WriteRemoteNamespace Void) -resolveConfiguredUrl pushPull destPath' = do - destPath <- Cli.resolvePath' destPath' - whenNothingM (remoteMappingForPath pushPull destPath) do - Cli.returnEarly (NoConfiguredRemoteMapping pushPull destPath) - --- | Tries to look up a remote mapping for a given path. --- Will also resolve paths relative to any mapping which is configured for a parent of that --- path. --- --- E.g. --- --- A config which maps: --- --- .myshare.foo -> .me.public.foo --- --- Will resolve the following local paths into share paths like so: --- --- .myshare.foo -> .me.public.foo --- .myshare.foo.bar -> .me.public.foo.bar --- .myshare.foo.bar.baz -> .me.public.foo.bar.baz --- .myshare -> -remoteMappingForPath :: PushPull -> Path.Absolute -> Cli (Maybe (WriteRemoteNamespace Void)) -remoteMappingForPath pushPull dest = do - pathPrefixes dest & Foldable.firstJustM \(prefix, suffix) -> do - let remoteMappingConfigKey = remoteMappingKey prefix - Cli.getConfig remoteMappingConfigKey >>= \case - Just url -> do - let parseResult = P.parse (UriParser.writeRemoteNamespaceWith empty) (Text.unpack remoteMappingConfigKey) url - in case parseResult of - Left err -> Cli.returnEarly (ConfiguredRemoteMappingParseError pushPull dest url (show err)) - Right wrp -> do - let remote = wrp & RemoteRepo.remotePath_ %~ \p -> Path.resolve p suffix - in pure $ Just remote - Nothing -> pure Nothing - where - -- Produces a list of path prefixes and suffixes, from longest prefix to shortest - -- - -- E.g. - -- - -- >>> pathPrefixes ("a" :< "b" :< Path.absoluteEmpty) - -- fromList [(.a.b,),(.a,b),(.,a.b)] - pathPrefixes :: Path.Absolute -> Seq (Path.Absolute, Path.Path) - pathPrefixes p = - Path.unabsolute p - & Path.toSeq - & \seq -> - Seq.zip (Seq.inits seq) (Seq.tails seq) - & Seq.reverse - <&> bimap (Path.Absolute . Path.Path) (Path.Path) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index dc73a118cc..e85879cc4a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -21,7 +21,6 @@ import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet import Data.Text qualified as Text -import Data.These (These (..)) import Data.Time (UTCTime) import Data.Tuple.Extra (uncurry3) import Text.Megaparsec qualified as Megaparsec @@ -29,19 +28,17 @@ import U.Codebase.Branch.Diff qualified as V2Branch.Diff import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Project qualified as Sqlite -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.ABT qualified as ABT import Unison.Builtin qualified as Builtin import Unison.Builtin.Terms qualified as Builtin import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils (getCurrentProjectBranch) import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch (..), Branch0) import Unison.Codebase.Branch qualified as Branch @@ -51,7 +48,6 @@ import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Causal qualified as Causal import Unison.Codebase.Editor.AuthorInfo (AuthorInfo (..)) import Unison.Codebase.Editor.AuthorInfo qualified as AuthorInfo -import Unison.Codebase.Editor.DisplayObject import Unison.Codebase.Editor.HandleInput.AddRun (handleAddRun) import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin) import Unison.Codebase.Editor.HandleInput.Branch (handleBranch) @@ -61,13 +57,16 @@ import Unison.Codebase.Editor.HandleInput.CommitMerge (handleCommitMerge) import Unison.Codebase.Editor.HandleInput.CommitUpgrade (handleCommitUpgrade) import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges +import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm) import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject) import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI) import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib) +import Unison.Codebase.Editor.HandleInput.LSPDebug qualified as LSPDebug import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile) +import Unison.Codebase.Editor.HandleInput.Ls (handleLs) import Unison.Codebase.Editor.HandleInput.Merge2 (handleMerge) import Unison.Codebase.Editor.HandleInput.MoveAll (handleMoveAll) import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch) @@ -82,18 +81,19 @@ import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch) import Unison.Codebase.Editor.HandleInput.Projects (handleProjects) import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch) import Unison.Codebase.Editor.HandleInput.Push (handlePushRemoteBranch) +import Unison.Codebase.Editor.HandleInput.Reflogs qualified as Reflogs import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft) import Unison.Codebase.Editor.HandleInput.Run (handleRun) import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) import Unison.Codebase.Editor.HandleInput.TermResolution (resolveMainRef) import Unison.Codebase.Editor.HandleInput.Tests qualified as Tests +import Unison.Codebase.Editor.HandleInput.Todo (handleTodo) import Unison.Codebase.Editor.HandleInput.UI (openUI) import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate) import Unison.Codebase.Editor.HandleInput.Update2 (handleUpdate2) import Unison.Codebase.Editor.HandleInput.Upgrade (handleUpgrade) import Unison.Codebase.Editor.Input -import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.Output.DumpNamespace qualified as Output.DN @@ -101,17 +101,14 @@ import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult import Unison.Codebase.Editor.StructuredArgument qualified as SA -import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase) import Unison.Codebase.Metadata qualified as Metadata -import Unison.Codebase.Patch (Patch (..)) -import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) -import Unison.Codebase.Path qualified as HQSplit' import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash qualified as SCH -import Unison.CommandLine.BranchRelativePath (BranchRelativePath) +import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) import Unison.CommandLine.Completion qualified as Completion import Unison.CommandLine.DisplayValues qualified as DisplayValues import Unison.CommandLine.InputPattern qualified as IP @@ -119,10 +116,8 @@ import Unison.CommandLine.InputPatterns qualified as IP import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration qualified as DD -import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' -import Unison.HashQualified' qualified as HashQualified +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.LabeledDependency qualified as LabeledDependency @@ -137,12 +132,8 @@ import Unison.Parser.Ann qualified as Ann import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE -import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.PrettyPrintEnvDecl.Names qualified as PPED -import Unison.Project (ProjectAndBranch (..)) -import Unison.Project.Util (projectContextFromPath) import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -182,7 +173,6 @@ import Unison.Util.Relation qualified as R import Unison.Util.Relation qualified as Relation import Unison.Util.Set qualified as Set import Unison.Util.Star2 qualified as Star2 -import Unison.Util.TransitiveClosure (transitiveClosure) import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind qualified as WK @@ -208,6 +198,7 @@ loop e = do Cli.respond $ Typechecked (Text.pack sourceName) suffixifiedPPE sr uf in Cli.time "InputPattern" case input of ApiI -> do + pp <- Cli.getCurrentProjectPath Cli.Env {serverBaseUrl} <- ask whenJust serverBaseUrl \baseUrl -> Cli.respond $ @@ -215,17 +206,17 @@ loop e = do P.lines [ "The API information is as follows:", P.newline, - P.indentN 2 (P.hiBlue ("UI: " <> Pretty.text (Server.urlFor (Server.LooseCodeUI Path.absoluteEmpty Nothing) baseUrl))), + P.indentN 2 (P.hiBlue ("UI: " <> Pretty.text (Server.urlFor (Server.ProjectBranchUI (PP.toProjectAndBranch . PP.toNames $ pp) Path.absoluteEmpty Nothing) baseUrl))), P.newline, P.indentN 2 (P.hiBlue ("API: " <> Pretty.text (Server.urlFor Server.Api baseUrl))) ] CreateMessage pretty -> Cli.respond $ PrintMessage pretty - ShowReflogI -> do + ShowRootReflogI -> do let numEntriesToShow = 500 (schLength, entries) <- Cli.runTransaction $ - (,) <$> Codebase.branchHashLength <*> Codebase.getReflog numEntriesToShow + (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow let moreEntriesToLoad = length entries == numEntriesToShow let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) let (shortEntries, numberedEntries) = @@ -254,109 +245,33 @@ loop e = do -- No expectation, either because this is the most recent entry or -- because we're recovering from a discontinuity Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) + ShowProjectBranchReflogI mayProjBranch -> do + Reflogs.showProjectBranchReflog mayProjBranch + ShowGlobalReflogI -> do + Reflogs.showGlobalReflog + ShowProjectReflogI mayProj -> do + Reflogs.showProjectReflog mayProj ResetI newRoot mtarget -> do - newRoot <- - case newRoot of - This newRoot -> case newRoot of - Left hash -> Cli.resolveShortCausalHash hash - Right path' -> Cli.expectBranchAtPath' path' - That (ProjectAndBranch mProjectName branchName) -> do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames arg - Cli.expectBranchAtPath' - ( Path.absoluteToPath' - ( ProjectUtils.projectBranchPath - (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId)) - ) - ) - These branchId (ProjectAndBranch mProjectName branchName) -> Cli.label \jump -> do - absPath <- case branchId of - Left hash -> jump =<< Cli.resolveShortCausalHash hash - Right path' -> Cli.resolvePath' path' - mrelativePath <- - Cli.getMaybeBranchAt absPath <&> \case - Nothing -> Nothing - Just _ -> preview ProjectUtils.projectBranchPathPrism absPath - projectAndBranch <- do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectUtils.getProjectAndBranchByTheseNames arg - thePath <- case (mrelativePath, projectAndBranch) of - (Nothing, Nothing) -> - ProjectUtils.getCurrentProject >>= \case - Nothing -> pure absPath - Just project -> - Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) - (Just (projectAndBranch0, relPath), Just (ProjectAndBranch project branch)) -> do - projectAndBranch0 <- Cli.runTransaction (ProjectUtils.expectProjectAndBranchByIds projectAndBranch0) - Cli.respondNumbered (AmbiguousReset AmbiguousReset'Hash (projectAndBranch0, relPath) (ProjectAndBranch (project ^. #name) (branch ^. #name))) - Cli.returnEarlyWithoutOutput - (Just _relativePath, Nothing) -> pure absPath - (Nothing, Just (ProjectAndBranch project branch)) -> - pure (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) - Cli.expectBranchAtPath' (Path.absoluteToPath' thePath) - + newRoot <- resolveBranchId2 newRoot target <- case mtarget of - Nothing -> Cli.getCurrentPath - Just looseCodeOrProject -> case looseCodeOrProject of - This path' -> Cli.resolvePath' path' - That (ProjectAndBranch mProjectName branchName) -> do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames arg - pure (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) - These path' (ProjectAndBranch mProjectName branchName) -> do - absPath <- Cli.resolvePath' path' - mrelativePath <- - Cli.getMaybeBranchAt absPath <&> \case - Nothing -> Nothing - Just _ -> preview ProjectUtils.projectBranchPathPrism absPath - projectAndBranch <- do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectUtils.getProjectAndBranchByTheseNames arg - case (mrelativePath, projectAndBranch) of - (Nothing, Nothing) -> - ProjectUtils.getCurrentProject >>= \case - Nothing -> pure absPath - Just project -> - Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) - (Just (projectAndBranch0, relPath), Just (ProjectAndBranch project branch)) -> do - projectAndBranch0 <- Cli.runTransaction (ProjectUtils.expectProjectAndBranchByIds projectAndBranch0) - Cli.respondNumbered (AmbiguousReset AmbiguousReset'Target (projectAndBranch0, relPath) (ProjectAndBranch (project ^. #name) (branch ^. #name))) - Cli.returnEarlyWithoutOutput - (Just _relativePath, Nothing) -> pure absPath - (Nothing, Just (ProjectAndBranch project branch)) -> - pure (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) + Nothing -> Cli.getCurrentProjectPath + Just unresolvedProjectAndBranch -> do + targetProjectAndBranch <- ProjectUtils.resolveProjectBranch (second Just unresolvedProjectAndBranch) + pure $ PP.projectBranchRoot targetProjectAndBranch description <- inputDescription input _ <- Cli.updateAt description target (const newRoot) Cli.respond Success - ResetRootI src0 -> - Cli.time "reset-root" do - newRoot <- - case src0 of - Left hash -> Cli.resolveShortCausalHash hash - Right path' -> Cli.expectBranchAtPath' path' - description <- inputDescription input - Cli.updateRoot newRoot description - Cli.respond Success ForkLocalBranchI src0 dest0 -> do (srcb, branchEmpty) <- case src0 of Left hash -> (,WhichBranchEmptyHash hash) <$> Cli.resolveShortCausalHash hash Right path' -> do - absPath <- ProjectUtils.branchRelativePathToAbsolute path' - let srcp = Path.AbsolutePath' absPath - srcb <- Cli.expectBranchAtPath' srcp - pure (srcb, WhichBranchEmptyPath srcp) + srcPP <- ProjectUtils.resolveBranchRelativePath path' + srcb <- Cli.getBranchFromProjectPath srcPP + pure (srcb, WhichBranchEmptyPath srcPP) description <- inputDescription input - dest <- ProjectUtils.branchRelativePathToAbsolute dest0 + dest <- ProjectUtils.resolveBranchRelativePath dest0 ok <- Cli.updateAtM description dest (const $ pure srcb) Cli.respond if ok @@ -364,45 +279,43 @@ loop e = do else BranchEmpty branchEmpty MergeI branch -> handleMerge branch MergeCommitI -> handleCommitMerge - MergeLocalBranchI src0 dest0 mergeMode -> do + MergeLocalBranchI unresolvedSrc mayUnresolvedDest mergeMode -> do description <- inputDescription input - src0 <- ProjectUtils.expectLooseCodeOrProjectBranch src0 - dest0 <- ProjectUtils.expectLooseCodeOrProjectBranch dest0 - let srcp = looseCodeOrProjectToPath src0 - let destp = looseCodeOrProjectToPath dest0 - srcb <- Cli.expectBranchAtPath' srcp - dest <- Cli.resolvePath' destp - let err = - Just $ - MergeAlreadyUpToDate - ((\x -> ProjectAndBranch x.project.name x.branch.name) <$> src0) - ((\x -> ProjectAndBranch x.project.name x.branch.name) <$> dest0) - mergeBranchAndPropagateDefaultPatch mergeMode description err srcb (Just dest0) dest - PreviewMergeLocalBranchI src0 dest0 -> do + srcPP <- ProjectUtils.resolveBranchRelativePath unresolvedSrc + (destPP, destBRP) <- case mayUnresolvedDest of + Nothing -> Cli.getCurrentProjectPath <&> \pp -> (pp, QualifiedBranchPath (pp ^. #project . #name) (pp ^. #branch . #name) (pp ^. PP.absPath_)) + Just unresolvedDest -> do + ProjectUtils.resolveBranchRelativePath unresolvedDest <&> \pp -> (pp, unresolvedDest) + srcBranch <- Cli.getProjectBranchRoot srcPP.branch + let err = Just $ MergeAlreadyUpToDate unresolvedSrc destBRP + mergeBranchAndPropagateDefaultPatch mergeMode description err srcBranch (Just $ Left destPP) destPP + PreviewMergeLocalBranchI unresolvedSrc mayUnresolvedDest -> do Cli.Env {codebase} <- ask - src0 <- ProjectUtils.expectLooseCodeOrProjectBranch src0 - dest0 <- ProjectUtils.expectLooseCodeOrProjectBranch dest0 - srcb <- Cli.expectBranchAtPath' $ looseCodeOrProjectToPath src0 - dest <- Cli.resolvePath' $ looseCodeOrProjectToPath dest0 - destb <- Cli.getBranchAt dest - merged <- liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) - if merged == destb - then Cli.respond (PreviewMergeAlreadyUpToDate src0 dest0) + srcPP <- ProjectUtils.resolveBranchRelativePath unresolvedSrc + destPP <- case mayUnresolvedDest of + Nothing -> Cli.getCurrentProjectPath + Just unresolvedDest -> do + ProjectUtils.resolveBranchRelativePath unresolvedDest + srcBranch <- Cli.getProjectBranchRoot srcPP.branch + destBranch <- Cli.getProjectBranchRoot destPP.branch + merged <- liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcBranch destBranch) + if merged == destBranch + then Cli.respond (PreviewMergeAlreadyUpToDate srcPP destPP) else do - (ppe, diff) <- diffHelper (Branch.head destb) (Branch.head merged) - Cli.respondNumbered (ShowDiffAfterMergePreview dest0 dest ppe diff) + (ppe, diff) <- diffHelper (Branch.head destBranch) (Branch.head merged) + Cli.respondNumbered (ShowDiffAfterMergePreview (Left destPP) destPP ppe diff) DiffNamespaceI before after -> do - absBefore <- traverseOf _Right Cli.resolvePath' before - absAfter <- traverseOf _Right Cli.resolvePath' after - beforeBranch0 <- Branch.head <$> Cli.resolveAbsBranchId absBefore - afterBranch0 <- Branch.head <$> Cli.resolveAbsBranchId absAfter + beforeLoc <- traverse ProjectUtils.resolveBranchRelativePath before + beforeBranch0 <- Branch.head <$> resolveBranchId2 before + afterLoc <- traverse ProjectUtils.resolveBranchRelativePath after + afterBranch0 <- Branch.head <$> resolveBranchId2 after case (Branch.isEmpty0 beforeBranch0, Branch.isEmpty0 afterBranch0) of - (True, True) -> Cli.returnEarly . NamespaceEmpty $ (absBefore Nel.:| [absAfter]) - (True, False) -> Cli.returnEarly . NamespaceEmpty $ (absBefore Nel.:| []) - (False, True) -> Cli.returnEarly . NamespaceEmpty $ (absAfter Nel.:| []) + (True, True) -> Cli.returnEarly . NamespaceEmpty $ (beforeLoc Nel.:| [afterLoc]) + (True, False) -> Cli.returnEarly . NamespaceEmpty $ (beforeLoc Nel.:| []) + (False, True) -> Cli.returnEarly . NamespaceEmpty $ (afterLoc Nel.:| []) (False, False) -> pure () (ppe, diff) <- diffHelper beforeBranch0 afterBranch0 - Cli.respondNumbered (ShowDiffNamespace absBefore absAfter ppe diff) + Cli.respondNumbered (ShowDiffNamespace beforeLoc afterLoc ppe diff) MoveBranchI src' dest' -> do hasConfirmed <- confirmedCommand input description <- inputDescription input @@ -410,8 +323,8 @@ loop e = do SwitchBranchI path' -> do path <- Cli.resolvePath' path' branchExists <- Cli.branchExistsAtPath' path' - when (not branchExists) (Cli.respond $ CreatedNewBranch path) - Cli.cd path + when (not branchExists) (Cli.respond $ CreatedNewBranch (path ^. PP.absPath_)) + Cli.cd (path ^. PP.absPath_) UpI -> do path0 <- Cli.getCurrentPath whenJust (unsnoc path0) \(path, _) -> @@ -422,10 +335,11 @@ loop e = do HistoryI resultsCap diffCap from -> do branch <- case from of - Left hash -> Cli.resolveShortCausalHash hash - Right path' -> do - path <- Cli.resolvePath' path' - Cli.getMaybeBranchAt path & onNothingM (Cli.returnEarly (CreatedNewBranch path)) + BranchAtSCH hash -> Cli.resolveShortCausalHash hash + BranchAtPath path' -> do + pp <- Cli.resolvePath' path' + Cli.getBranchFromProjectPath pp + BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp schLength <- Cli.runTransaction Codebase.branchHashLength history <- liftIO (doHistory schLength 0 branch []) Cli.respondNumbered history @@ -443,7 +357,7 @@ loop e = do let elem = (Branch.headHash b, Branch.namesDiff b' b) doHistory schLength (n + 1) b' (elem : acc) UndoI -> do - rootBranch <- Cli.getRootBranch + rootBranch <- Cli.getCurrentProjectRoot (_, prev) <- liftIO (Branch.uncons rootBranch) & onNothingM do Cli.returnEarly . CantUndo $ @@ -451,7 +365,8 @@ loop e = do then CantUndoPastStart else CantUndoPastMerge description <- inputDescription input - Cli.updateRoot prev description + pb <- getCurrentProjectBranch + Cli.updateProjectBranchRoot_ pb description (const prev) (ppe, diff) <- diffHelper (Branch.head prev) (Branch.head rootBranch) Cli.respondNumbered (Output.ShowDiffAfterUndo ppe diff) UiI path' -> openUI path' @@ -470,11 +385,11 @@ loop e = do Cli.respond $ Output.MarkdownOut (Text.intercalate "\n---\n" mdText) DocsToHtmlI namespacePath' sourceDirectory -> do Cli.Env {codebase, sandboxedRuntime} <- ask - absPath <- Cli.resolvePath' namespacePath' - branch <- liftIO $ Codebase.getBranchAtPath codebase absPath + projPath <- ProjectUtils.resolveBranchRelativePath namespacePath' + branch <- Cli.getBranchFromProjectPath projPath _evalErrs <- liftIO $ (Backend.docsInBranchToHtmlFiles sandboxedRuntime codebase branch sourceDirectory) pure () - AliasTermI src' dest' -> do + AliasTermI force src' dest' -> do Cli.Env {codebase} <- ask src <- traverseOf _Right Cli.resolveSplit' src' srcTerms <- @@ -493,12 +408,12 @@ loop e = do pure (DeleteNameAmbiguous hqLength name srcTerms Set.empty) dest <- Cli.resolveSplit' dest' destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest) - when (not (Set.null destTerms)) do + when (not force && not (Set.null destTerms)) do Cli.returnEarly (TermAlreadyExists dest' destTerms) description <- inputDescription input - Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm) + Cli.stepAt description (BranchUtil.makeAddTermName dest srcTerm) Cli.respond Success - AliasTypeI src' dest' -> do + AliasTypeI force src' dest' -> do src <- traverseOf _Right Cli.resolveSplit' src' srcTypes <- either @@ -516,25 +431,25 @@ loop e = do pure (DeleteNameAmbiguous hqLength name Set.empty srcTypes) dest <- Cli.resolveSplit' dest' destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest) - when (not (Set.null destTypes)) do + when (not force && not (Set.null destTypes)) do Cli.returnEarly (TypeAlreadyExists dest' destTypes) description <- inputDescription input - Cli.stepAt description (BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType) + Cli.stepAt description (BranchUtil.makeAddTypeName dest srcType) Cli.respond Success -- this implementation will happily produce name conflicts, -- but will surface them in a normal diff at the end of the operation. AliasManyI srcs dest' -> do - root0 <- Cli.getRootBranch0 + root0 <- Cli.getCurrentProjectRoot0 currentBranch0 <- Cli.getCurrentBranch0 - destAbs <- Cli.resolvePath' dest' - old <- Cli.getBranch0At destAbs + destPP <- Cli.resolvePath' dest' + old <- Cli.getBranch0FromProjectPath destPP description <- inputDescription input - let (unknown, actions) = foldl' (go root0 currentBranch0 destAbs) mempty srcs - Cli.stepManyAt description actions - new <- Cli.getBranch0At destAbs + let (unknown, actions) = foldl' (go root0 currentBranch0 (PP.absPath destPP)) mempty srcs + Cli.stepManyAt destPP.branch description actions + new <- Cli.getBranch0FromProjectPath destPP (ppe, diff) <- diffHelper old new - Cli.respondNumbered (ShowDiffAfterModifyBranch dest' destAbs ppe diff) + Cli.respondNumbered (ShowDiffAfterModifyBranch dest' (destPP.absPath) ppe diff) when (not (null unknown)) do Cli.respond . SearchTermsNotFound . fmap fixupOutput $ unknown where @@ -543,28 +458,29 @@ loop e = do Branch0 IO -> Branch0 IO -> Path.Absolute -> - ([Path.HQSplit], [(Path, Branch0 m -> Branch0 m)]) -> + ([Path.HQSplit], [(Path.Absolute, Branch0 m -> Branch0 m)]) -> Path.HQSplit -> - ([Path.HQSplit], [(Path, Branch0 m -> Branch0 m)]) + ([Path.HQSplit], [(Path.Absolute, Branch0 m -> Branch0 m)]) go root0 currentBranch0 dest (missingSrcs, actions) hqsrc = - let proposedDest :: Path.Split + let proposedDest :: Path.AbsSplit proposedDest = second HQ'.toName hqProposedDest - hqProposedDest :: Path.HQSplit - hqProposedDest = first Path.unabsolute $ Path.resolve dest hqsrc + hqProposedDest :: Path.HQSplitAbsolute + hqProposedDest = Path.resolve dest hqsrc -- `Nothing` if src doesn't exist - doType :: Maybe [(Path, Branch0 m -> Branch0 m)] + doType :: Maybe [(Path.Absolute, Branch0 m -> Branch0 m)] doType = case ( BranchUtil.getType hqsrc currentBranch0, - BranchUtil.getType hqProposedDest root0 + BranchUtil.getType (first Path.unabsolute hqProposedDest) root0 ) of (null -> True, _) -> Nothing -- missing src (rsrcs, existing) -> -- happy path Just . map addAlias . toList $ Set.difference rsrcs existing where + addAlias :: Reference -> (Path.Absolute, Branch0 m -> Branch0 m) addAlias r = BranchUtil.makeAddTypeName proposedDest r - doTerm :: Maybe [(Path, Branch0 m -> Branch0 m)] + doTerm :: Maybe [(Path.Absolute, Branch0 m -> Branch0 m)] doTerm = case ( BranchUtil.getTerm hqsrc currentBranch0, - BranchUtil.getTerm hqProposedDest root0 + BranchUtil.getTerm (first Path.unabsolute hqProposedDest) root0 ) of (null -> True, _) -> Nothing -- missing src (rsrcs, existing) -> @@ -578,18 +494,13 @@ loop e = do (Just as1, Just as2) -> (missingSrcs, actions ++ as1 ++ as2) fixupOutput :: Path.HQSplit -> HQ.HashQualified Name - fixupOutput = fmap Path.unsafeToName . HQ'.toHQ . Path.unsplitHQ + fixupOutput = HQ'.toHQ . Path.nameFromHQSplit NamesI global query -> do hqLength <- Cli.runTransaction Codebase.hashLength - root <- Cli.getRootBranch (names, pped) <- - if global || any Name.isAbsolute query + if global then do - let root0 = Branch.head root - -- Use an absolutely qualified ppe for view.global - let names = Names.makeAbsolute $ Branch.toNames root0 - let pped = PPED.makePPED (PPE.hqNamer hqLength names) (PPE.suffixifyByHash names) - pure (names, pped) + error "TODO: Implement names.global." else do names <- Cli.currentNames pped <- Cli.prettyPrintEnvDeclFromNames names @@ -619,11 +530,13 @@ loop e = do authorPath <- Cli.resolveSplit' authorPath' copyrightHolderPath <- Cli.resolveSplit' (base |> NameSegment.copyrightHoldersSegment |> authorNameSegment) guidPath <- Cli.resolveSplit' (authorPath' |> NameSegment.guidSegment) + pb <- Cli.getCurrentProjectBranch Cli.stepManyAt + pb description - [ BranchUtil.makeAddTermName (first Path.unabsolute authorPath) (d authorRef), - BranchUtil.makeAddTermName (first Path.unabsolute copyrightHolderPath) (d copyrightHolderRef), - BranchUtil.makeAddTermName (first Path.unabsolute guidPath) (d guidRef) + [ BranchUtil.makeAddTermName (first PP.absPath authorPath) (d authorRef), + BranchUtil.makeAddTermName (first PP.absPath copyrightHolderPath) (d copyrightHolderRef), + BranchUtil.makeAddTermName (first PP.absPath guidPath) (d guidRef) ] currentPath <- Cli.getCurrentPath finalBranch <- Cli.getCurrentBranch0 @@ -646,67 +559,59 @@ loop e = do hasConfirmed <- confirmedCommand input desc <- inputDescription input handleMoveAll hasConfirmed src' dest' desc - DeleteI dtarget -> case dtarget of - DeleteTarget'TermOrType doutput hqs -> delete input doutput Cli.getTermsAt Cli.getTypesAt hqs - DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) Cli.getTypesAt hqs - DeleteTarget'Term doutput hqs -> delete input doutput Cli.getTermsAt (const (pure Set.empty)) hqs - DeleteTarget'Namespace insistence Nothing -> do - hasConfirmed <- confirmedCommand input - if hasConfirmed || insistence == Force - then do - description <- inputDescription input - Cli.updateRoot Branch.empty description - Cli.respond DeletedEverything - else Cli.respond DeleteEverythingConfirmation - DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do - branch <- Cli.expectBranchAtPath (Path.unsplit p) - description <- inputDescription input - let toDelete = - Names.prefix0 - (Path.unsafeToName (Path.unsplit (p))) - (Branch.toNames (Branch.head branch)) - afterDelete <- do - names <- Cli.currentNames - endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names) - case (null endangerments, insistence) of - (True, _) -> pure (Cli.respond Success) - (False, Force) -> do - ppeDecl <- Cli.currentPrettyPrintEnvDecl - pure do - Cli.respond Success - Cli.respondNumbered $ DeletedDespiteDependents ppeDecl endangerments - (False, Try) -> do - ppeDecl <- Cli.currentPrettyPrintEnvDecl - Cli.respondNumbered $ CantDeleteNamespace ppeDecl endangerments - Cli.returnEarlyWithoutOutput - parentPathAbs <- Cli.resolvePath parentPath - -- We have to modify the parent in order to also wipe out the history at the - -- child. - Cli.updateAt description parentPathAbs \parentBranch -> - parentBranch - & Branch.modifyAt (Path.singleton childName) \_ -> Branch.empty - afterDelete - DeleteTarget'ProjectBranch name -> handleDeleteBranch name - DeleteTarget'Project name -> handleDeleteProject name + DeleteI dtarget -> do + pp <- Cli.getCurrentProjectPath + let getTerms (absPath, seg) = Cli.getTermsAt (set PP.absPath_ absPath pp, seg) + let getTypes (absPath, seg) = Cli.getTypesAt (set PP.absPath_ absPath pp, seg) + case dtarget of + DeleteTarget'TermOrType doutput hqs -> do + delete input doutput getTerms getTypes hqs + DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) getTypes hqs + DeleteTarget'Term doutput hqs -> delete input doutput getTerms (const (pure Set.empty)) hqs + DeleteTarget'Namespace insistence Nothing -> do + hasConfirmed <- confirmedCommand input + if hasConfirmed || insistence == Force + then do + description <- inputDescription input + pp <- Cli.getCurrentProjectPath + _ <- Cli.updateAt description pp (const Branch.empty) + Cli.respond DeletedEverything + else Cli.respond DeleteEverythingConfirmation + DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do + branch <- Cli.expectBranchAtPath (Path.unsplit p) + description <- inputDescription input + let toDelete = + Names.prefix0 + (Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative) p) + (Branch.toNames (Branch.head branch)) + afterDelete <- do + names <- Cli.currentNames + endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names) + case (null endangerments, insistence) of + (True, _) -> pure (Cli.respond Success) + (False, Force) -> do + ppeDecl <- Cli.currentPrettyPrintEnvDecl + pure do + Cli.respond Success + Cli.respondNumbered $ DeletedDespiteDependents ppeDecl endangerments + (False, Try) -> do + ppeDecl <- Cli.currentPrettyPrintEnvDecl + Cli.respondNumbered $ CantDeleteNamespace ppeDecl endangerments + Cli.returnEarlyWithoutOutput + parentPathAbs <- Cli.resolvePath parentPath + -- We have to modify the parent in order to also wipe out the history at the + -- child. + Cli.updateAt description parentPathAbs \parentBranch -> + parentBranch + & Branch.modifyAt (Path.singleton childName) \_ -> Branch.empty + afterDelete + DeleteTarget'ProjectBranch name -> handleDeleteBranch name + DeleteTarget'Project name -> handleDeleteProject name DisplayI outputLoc namesToDisplay -> do traverse_ (displayI outputLoc) namesToDisplay ShowDefinitionI outputLoc showDefinitionScope query -> handleShowDefinition outputLoc showDefinitionScope query EditNamespaceI paths -> handleEditNamespace LatestFileLocation paths - FindShallowI pathArg -> do - Cli.Env {codebase} <- ask - - pathArgAbs <- Cli.resolvePath' pathArg - entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) - Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries - pped <- Cli.currentPrettyPrintEnvDecl - let suffixifiedPPE = PPED.suffixifiedPPE pped - -- This used to be a delayed action which only forced the loading of the root - -- branch when it was necessary for printing the results, but that got wiped out - -- when we ported to the new Cli monad. - -- It would be nice to restore it, but it's pretty rare that it actually results - -- in an improvement, so perhaps it's not worth the effort. - let buildPPE = pure suffixifiedPPE - Cli.respond $ ListShallow buildPPE entries + FindShallowI pathArg -> handleLs pathArg FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input StructuredFindI _fscope ws -> handleStructuredFindI ws StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws @@ -717,16 +622,15 @@ loop e = do let vars = Set.map Name.toVar requestedNames uf <- Cli.expectLatestTypecheckedFile Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath currentNames <- Branch.toNames <$> Cli.getCurrentBranch0 let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames let adds = SlurpResult.adds sr - Cli.stepAtNoSync (Path.unabsolute currentPath, doSlurpAdds adds uf) Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf + pp <- Cli.getCurrentProjectPath + Cli.stepAt description (pp, doSlurpAdds adds uf) pped <- Cli.prettyPrintEnvDeclFromNames $ UF.addNamesFromTypeCheckedUnisonFile uf currentNames let suffixifiedPPE = PPED.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr - Cli.syncRoot description SaveExecuteResultI resultName -> handleAddRun input resultName PreviewAddI requestedNames -> do (sourceName, _) <- Cli.expectLatestFile @@ -744,10 +648,7 @@ loop e = do currentNames <- Branch.toNames <$> Cli.getCurrentBranch0 let sr = Slurp.slurpFile uf vars Slurp.UpdateOp currentNames previewResponse sourceName sr uf - TodoI patchPath branchPath' -> do - patch <- Cli.getPatchAt (fromMaybe Cli.defaultPatchPath patchPath) - branchPath <- Cli.resolvePath' branchPath' - doShowTodoOutput patch branchPath + TodoI -> handleTodo TestI testInput -> Tests.handleTest testInput ExecuteI main args -> handleRun False main args MakeStandaloneI output main -> doCompile False output main @@ -779,7 +680,8 @@ loop e = do let destPath = case opath of Just path -> Path.resolve currentPath (Path.Relative path) Nothing -> currentPath `snoc` NameSegment.builtinSegment - _ <- Cli.updateAtM description destPath \destb -> + pp <- set PP.absPath_ destPath <$> Cli.getCurrentProjectPath + _ <- Cli.updateAtM description pp \destb -> liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) Cli.respond Success MergeIOBuiltinsI opath -> do @@ -806,7 +708,8 @@ loop e = do let destPath = case opath of Just path -> Path.resolve currentPath (Path.Relative path) Nothing -> currentPath `snoc` NameSegment.builtinSegment - _ <- Cli.updateAtM description destPath \destb -> + pp <- set PP.absPath_ destPath <$> Cli.getCurrentProjectPath + _ <- Cli.updateAtM description pp \destb -> liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) Cli.respond Success PullI sourceTarget pullMode -> handlePull sourceTarget pullMode @@ -828,20 +731,21 @@ loop e = do Cli.respond $ DumpUnisonFileHashes hqLength datas effects terms DebugTabCompletionI inputs -> do Cli.Env {authHTTPClient, codebase} <- ask - currentPath <- Cli.getCurrentPath - let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient currentPath + pp <- Cli.getCurrentProjectPath + let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient pp (_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "") Cli.respond (DisplayDebugCompletions completions) + DebugLSPNameCompletionI prefix -> do + LSPDebug.debugLspNameCompletion prefix DebugFuzzyOptionsI command args -> do Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath currentBranch <- Branch.withoutTransitiveLibs <$> Cli.getCurrentBranch0 - let projCtx = projectContextFromPath currentPath case Map.lookup command InputPatterns.patternMap of Just (IP.InputPattern {args = argTypes}) -> do zip argTypes args & Monoid.foldMapM \case ((argName, _, IP.ArgumentType {fzfResolver = Just IP.FZFResolver {getOptions}}), "_") -> do - results <- liftIO $ getOptions codebase projCtx currentBranch + pp <- Cli.getCurrentProjectPath + results <- liftIO $ getOptions codebase pp currentBranch Cli.respond (DebugDisplayFuzzyOptions argName (Text.unpack <$> results)) ((_, _, IP.ArgumentType {fzfResolver = Nothing}), "_") -> do Cli.respond DebugFuzzyOptionsNoResolver @@ -911,13 +815,13 @@ loop e = do prettyRef renderR r = P.indentN 2 $ P.text (renderR r) prettyDefn renderR (r, Foldable.toList -> names) = P.lines (P.text <$> if null names then [""] else NameSegment.toEscapedText <$> names) <> P.newline <> prettyRef renderR r - rootBranch <- Cli.getRootBranch - void . liftIO . flip State.execStateT mempty $ goCausal [getCausal rootBranch] + projectRoot <- Cli.getCurrentProjectRoot + void . liftIO . flip State.execStateT mempty $ goCausal [getCausal projectRoot] DebugDumpNamespaceSimpleI -> do - rootBranch0 <- Cli.getRootBranch0 - for_ (Relation.toList . Branch.deepTypes $ rootBranch0) \(r, name) -> + projectRootBranch0 <- Cli.getCurrentProjectRoot0 + for_ (Relation.toList . Branch.deepTypes $ projectRootBranch0) \(r, name) -> traceM $ show name ++ ",Type," ++ Text.unpack (Reference.toText r) - for_ (Relation.toList . Branch.deepTerms $ rootBranch0) \(r, name) -> + for_ (Relation.toList . Branch.deepTerms $ projectRootBranch0) \(r, name) -> traceM $ show name ++ ",Term," ++ Text.unpack (Referent.toText r) DebugTermI isVerbose hqName -> DebugDefinition.debugTerm isVerbose hqName DebugLSPFoldRangesI -> do @@ -957,7 +861,7 @@ loop e = do Cli.respond $ PrintVersion ucmVersion ProjectRenameI name -> handleProjectRename name ProjectSwitchI name -> projectSwitch name - ProjectCreateI tryDownloadingBase name -> projectCreate tryDownloadingBase name + ProjectCreateI tryDownloadingBase name -> void $ projectCreate tryDownloadingBase name ProjectsI -> handleProjects BranchI source name -> handleBranch source name BranchRenameI name -> handleBranchRename name @@ -967,6 +871,7 @@ loop e = do UpgradeI old new -> handleUpgrade old new UpgradeCommitI -> handleCommitUpgrade LibInstallI remind libdep -> handleInstallLib remind libdep + DebugSynhashTermI name -> handleDebugSynhashTerm name inputDescription :: Input -> Cli Text inputDescription input = @@ -977,35 +882,29 @@ inputDescription input = dest <- brp dest0 pure ("fork " <> src <> " " <> dest) MergeLocalBranchI src0 dest0 mode -> do - src <- looseCodeOrProjectToText src0 - dest <- looseCodeOrProjectToText dest0 + let src = into @Text src0 + let dest = maybe "" (into @Text) dest0 let command = case mode of Branch.RegularMerge -> "merge" Branch.SquashMerge -> "merge.squash" pure (command <> " " <> src <> " " <> dest) - ResetI hash tgt -> do - hashTxt <- case hash of - This hash -> hp' hash - That pr -> pure (into @Text pr) - These hash _pr -> hp' hash + ResetI newRoot tgt -> do + hashTxt <- bid2 newRoot tgt <- case tgt of Nothing -> pure "" Just tgt -> do - tgt <- looseCodeOrProjectToText tgt - pure (" " <> tgt) + let tgtText = into @Text tgt + pure (" " <> tgtText) pure ("reset " <> hashTxt <> tgt) - ResetRootI src0 -> do - src <- hp' src0 - pure ("reset-root " <> src) - AliasTermI src0 dest0 -> do + AliasTermI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 - pure ("alias.term " <> src <> " " <> dest) - AliasTypeI src0 dest0 -> do + pure ((if force then "debug.alias.term.force " else "alias.term ") <> src <> " " <> dest) + AliasTypeI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 - pure ("alias.type " <> src <> " " <> dest) + pure ((if force then "debug.alias.type.force " else "alias.term ") <> src <> " " <> dest) AliasManyI srcs0 dest0 -> do srcs <- traverse hqs srcs0 dest <- p' dest0 @@ -1079,7 +978,17 @@ inputDescription input = CreateAuthorI id name -> pure ("create.author " <> NameSegment.toEscapedText id <> " " <> name) ClearI {} -> pure "clear" DocToMarkdownI name -> pure ("debug.doc-to-markdown " <> Name.toText name) - -- + DebugTermI verbose hqName -> + if verbose + then pure ("debug.term.verbose " <> HQ.toText hqName) + else pure ("debug.term " <> HQ.toText hqName) + DebugTypeI hqName -> pure ("debug.type " <> HQ.toText hqName) + DebugLSPFoldRangesI -> pure "debug.lsp.fold-ranges" + DebugFuzzyOptionsI cmd input -> pure . Text.pack $ "debug.fuzzy-completions " <> unwords (cmd : toList input) + DebugFormatI -> pure "debug.format" + EditNamespaceI paths -> + pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths)) + -- wat land ApiI -> wat AuthLoginI {} -> wat BranchI {} -> wat @@ -1091,17 +1000,11 @@ inputDescription input = DebugDoctorI {} -> wat DebugDumpNamespaceSimpleI {} -> wat DebugDumpNamespacesI {} -> wat - DebugTermI verbose hqName -> - if verbose - then pure ("debug.term.verbose " <> HQ.toText hqName) - else pure ("debug.term " <> HQ.toText hqName) - DebugTypeI hqName -> pure ("debug.type " <> HQ.toText hqName) - DebugLSPFoldRangesI -> pure "debug.lsp.fold-ranges" + DebugLSPNameCompletionI {} -> wat DebugNameDiffI {} -> wat DebugNumberedArgsI {} -> wat - DebugTabCompletionI _input -> wat - DebugFuzzyOptionsI cmd input -> pure . Text.pack $ "debug.fuzzy-completions " <> unwords (cmd : toList input) - DebugFormatI -> pure "debug.format" + DebugSynhashTermI {} -> wat + DebugTabCompletionI {} -> wat DebugTypecheckedUnisonFileI {} -> wat DiffNamespaceI {} -> wat DisplayI {} -> wat @@ -1109,15 +1012,13 @@ inputDescription input = DocsToHtmlI {} -> wat FindI {} -> wat FindShallowI {} -> wat - StructuredFindI {} -> wat - StructuredFindReplaceI {} -> wat HistoryI {} -> wat LibInstallI {} -> wat ListDependenciesI {} -> wat ListDependentsI {} -> wat LoadI {} -> wat - MergeI {} -> wat MergeCommitI {} -> wat + MergeI {} -> wat NamesI {} -> wat NamespaceDependenciesI {} -> wat PopBranchI {} -> wat @@ -1133,26 +1034,34 @@ inputDescription input = QuitI {} -> wat ReleaseDraftI {} -> wat ShowDefinitionI {} -> wat - EditNamespaceI paths -> - pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths)) - ShowReflogI {} -> wat + StructuredFindI {} -> wat + StructuredFindReplaceI {} -> wat + ShowRootReflogI {} -> pure "deprecated.root-reflog" + ShowGlobalReflogI {} -> pure "reflog.global" + ShowProjectReflogI mayProjName -> do + case mayProjName of + Nothing -> pure "project.reflog" + Just projName -> pure $ "project.reflog" <> into @Text projName + ShowProjectBranchReflogI mayProjBranch -> do + case mayProjBranch of + Nothing -> pure "branch.reflog" + Just (PP.ProjectAndBranch Nothing branchName) -> pure $ "branch.reflog" <> into @Text branchName + Just (PP.ProjectAndBranch (Just projName) branchName) -> pure $ "branch.reflog" <> into @Text (PP.ProjectAndBranch projName branchName) SwitchBranchI {} -> wat TestI {} -> wat TodoI {} -> wat UiI {} -> wat UpI {} -> wat - UpgradeI {} -> wat UpgradeCommitI {} -> wat + UpgradeI {} -> wat VersionI -> wat where - hp' :: Either SCH.ShortCausalHash Path' -> Cli Text - hp' = either (pure . Text.pack . show) p' p :: Path -> Cli Text - p = fmap tShow . Cli.resolvePath + p = fmap (into @Text) . Cli.resolvePath p' :: Path' -> Cli Text - p' = fmap tShow . Cli.resolvePath' + p' = fmap (into @Text) . Cli.resolvePath' brp :: BranchRelativePath -> Cli Text - brp = fmap from . ProjectUtils.resolveBranchRelativePath + brp = fmap (into @Text) . ProjectUtils.resolveBranchRelativePath ops :: Maybe Path.Split -> Cli Text ops = maybe (pure ".") ps wat = error $ show input ++ " is not expected to alter the branch" @@ -1167,12 +1076,10 @@ inputDescription input = hqs (p, hq) = hqs' (Path' . Right . Path.Relative $ p, hq) ps' = p' . Path.unsplit' ps = p . Path.unsplit - looseCodeOrProjectToText :: Input.LooseCodeOrProject -> Cli Text - looseCodeOrProjectToText = \case - This path -> p' path - That branch -> pure (into @Text branch) - -- just trying to recover the syntax the user wrote - These path _branch -> pure (Path.toText' path) + bid2 :: BranchId2 -> Cli Text + bid2 = \case + Left sch -> pure $ into @Text sch + Right p -> brp p handleFindI :: Bool -> @@ -1185,7 +1092,7 @@ handleFindI isVerbose fscope ws input = do (pped, names, searchRoot, branch0) <- case fscope of FindLocal p -> do searchRoot <- Cli.resolvePath' p - branch0 <- Cli.getBranch0At searchRoot + branch0 <- Cli.getBranch0FromProjectPath searchRoot let names = Branch.toNames (Branch.withoutLib branch0) -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. @@ -1193,17 +1100,18 @@ handleFindI isVerbose fscope ws input = do pure (pped, names, Just p, branch0) FindLocalAndDeps p -> do searchRoot <- Cli.resolvePath' p - branch0 <- Cli.getBranch0At searchRoot + branch0 <- Cli.getBranch0FromProjectPath searchRoot let names = Branch.toNames (Branch.withoutTransitiveLibs branch0) -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. pped <- Cli.currentPrettyPrintEnvDecl pure (pped, names, Just p, branch0) FindGlobal -> do - globalNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getRootBranch0 - pped <- Cli.prettyPrintEnvDeclFromNames globalNames + -- TODO: Rewrite to be properly global again + projectRootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getCurrentProjectRoot0 + pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames currentBranch0 <- Cli.getCurrentBranch0 - pure (pped, globalNames, Nothing, currentBranch0) + pure (pped, projectRootNames, Nothing, currentBranch0) let suffixifiedPPE = PPED.suffixifiedPPE pped let getResults :: Names -> Cli [SearchResult] getResults names = @@ -1339,16 +1247,16 @@ handleShowDefinition outputLoc showDefinitionScope query = do hqLength <- Cli.runTransaction Codebase.hashLength let hasAbsoluteQuery = any (any Name.isAbsolute) query (names, unbiasedPPED) <- case (hasAbsoluteQuery, showDefinitionScope) of - -- If any of the queries are absolute, use global names. -- TODO: We should instead print each definition using the names from its project-branch root. (True, _) -> do - root <- Cli.getRootBranch + root <- Cli.getCurrentProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names pure (names, pped) (_, ShowDefinitionGlobal) -> do - root <- Cli.getRootBranch + -- TODO: Maybe rewrite to be properly global + root <- Cli.getCurrentProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names @@ -1433,58 +1341,6 @@ doDisplay outputLoc names tm = do else do writeUtf8 filePath txt --- | Show todo output if there are any conflicts or edits. -doShowTodoOutput :: Patch -> Path.Absolute -> Cli () -doShowTodoOutput patch scopePath = do - Cli.Env {codebase} <- ask - names0 <- Branch.toNames <$> Cli.getBranch0At scopePath - todo <- Cli.runTransaction (checkTodo codebase patch names0) - if TO.noConflicts todo && TO.noEdits todo - then Cli.respond NoConflictsOrEdits - else do - Cli.setNumberedArgs $ - SA.HashQualified . HQ.HashOnly . Reference.toShortHash . view _2 - <$> fst (TO.todoFrontierDependents todo) - pped <- Cli.currentPrettyPrintEnvDecl - Cli.respondNumbered $ TodoOutput pped todo - -checkTodo :: Codebase m Symbol Ann -> Patch -> Names -> Sqlite.Transaction (TO.TodoOutput Symbol Ann) -checkTodo codebase patch names0 = do - let -- Get the dependents of a reference which: - -- 1. Don't appear on the LHS of this patch - -- 2. Have a name in this namespace - getDependents :: Reference -> Sqlite.Transaction (Set Reference) - getDependents ref = do - dependents <- Codebase.dependents Queries.ExcludeSelf ref - pure (dependents & removeEditedThings & removeNamelessThings) - -- (r,r2) ∈ dependsOn if r depends on r2, excluding self-references (i.e. (r,r)) - dependsOn <- Monoid.foldMapM (\ref -> R.fromManyDom <$> getDependents ref <*> pure ref) edited - let dirty = R.dom dependsOn - transitiveDirty <- transitiveClosure getDependents dirty - (frontierTerms, frontierTypes) <- loadDisplayInfo codebase (R.ran dependsOn) - (dirtyTerms, dirtyTypes) <- loadDisplayInfo codebase dirty - pure $ - TO.TodoOutput - (Set.size transitiveDirty) - (frontierTerms, frontierTypes) - (score dirtyTerms, score dirtyTypes) - (Names.conflicts names0) - (Patch.conflicts patch) - where - -- Remove from a all references that were edited, i.e. appear on the LHS of this patch. - removeEditedThings :: Set Reference -> Set Reference - removeEditedThings = - (`Set.difference` edited) - -- Remove all references that don't have a name in the given namespace - removeNamelessThings :: Set Reference -> Set Reference - removeNamelessThings = - Set.filter (Names.contains names0) - -- todo: something more intelligent here? - score :: [(a, b)] -> [(TO.Score, a, b)] - score = map (\(x, y) -> (1, x, y)) - edited :: Set Reference - edited = R.dom (Patch._termEdits patch) <> R.dom (Patch._typeEdits patch) - confirmedCommand :: Input -> Cli Bool confirmedCommand i = do loopState <- State.get @@ -1602,8 +1458,8 @@ delete input doutput getTerms getTypes hqs' = do traverse ( \hq -> do absolute <- Cli.resolveSplit' hq - types <- getTypes absolute - terms <- getTerms absolute + types <- getTypes (first PP.absPath absolute) + terms <- getTerms (first PP.absPath absolute) return (hq, types, terms) ) hqs' @@ -1613,7 +1469,7 @@ delete input doutput getTerms getTypes hqs' = do then do let toName :: [(Path.HQSplit', Set Reference, Set referent)] -> [Name] toName notFounds = - mapMaybe (\(split, _, _) -> Path.toName' $ HashQualified.toName (HQSplit'.unsplitHQ' split)) notFounds + map (\(split, _, _) -> HQ'.toName $ Path.nameFromHQSplit' split) notFounds Cli.returnEarly $ NamesNotFound (toName notFounds) else do checkDeletes typesTermsTuple doutput input @@ -1622,19 +1478,20 @@ checkDeletes :: [(Path.HQSplit', Set Reference, Set Referent)] -> DeleteOutput - checkDeletes typesTermsTuples doutput inputs = do let toSplitName :: (Path.HQSplit', Set Reference, Set Referent) -> - Cli (Path.Split, Name, Set Reference, Set Referent) + Cli (Path.AbsSplit, Name, Set Reference, Set Referent) toSplitName hq = do - resolvedPath <- first Path.unabsolute <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1) - return (resolvedPath, Path.unsafeToName (Path.unsplit resolvedPath), hq ^. _2, hq ^. _3) + (pp, ns) <- Cli.resolveSplit' (HQ'.toName <$> hq ^. _1) + let resolvedSplit = (pp.absPath, ns) + return + (resolvedSplit, Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative . Path.unabsolute) resolvedSplit, hq ^. _2, hq ^. _3) + -- get the splits and names with terms and types splitsNames <- traverse toSplitName typesTermsTuples let toRel :: (Ord ref) => Set ref -> Name -> R.Relation Name ref toRel setRef name = R.fromList (fmap (name,) (toList setRef)) let toDelete = fmap (\(_, names, types, terms) -> Names (toRel terms names) (toRel types names)) splitsNames -- make sure endangered is compeletely contained in paths - -- TODO: We should just check for endangerments from the project root, not the - -- global root! - rootNames <- Branch.toNames <$> Cli.getRootBranch0 + projectNames <- Branch.toNames <$> Cli.getCurrentProjectRoot0 -- get only once for the entire deletion set let allTermsToDelete :: Set LabeledDependency allTermsToDelete = Set.unions (fmap Names.labeledReferences toDelete) @@ -1643,7 +1500,7 @@ checkDeletes typesTermsTuples doutput inputs = do Cli.runTransaction $ traverse ( \targetToDelete -> - getEndangeredDependents targetToDelete (allTermsToDelete) rootNames + getEndangeredDependents targetToDelete (allTermsToDelete) projectNames ) toDelete -- If the overall dependency map is not completely empty, abort deletion @@ -1658,7 +1515,8 @@ checkDeletes typesTermsTuples doutput inputs = do ) before <- Cli.getCurrentBranch0 description <- inputDescription inputs - Cli.stepManyAt description deleteTypesTerms + pb <- Cli.getCurrentProjectBranch + Cli.stepManyAt pb description deleteTypesTerms case doutput of DeleteOutput'Diff -> do after <- Cli.getCurrentBranch0 @@ -1667,7 +1525,7 @@ checkDeletes typesTermsTuples doutput inputs = do DeleteOutput'NoDiff -> do Cli.respond Success else do - ppeDecl <- Cli.prettyPrintEnvDeclFromNames rootNames + ppeDecl <- Cli.prettyPrintEnvDeclFromNames projectNames let combineRefs = List.foldl (Map.unionWith NESet.union) Map.empty endangeredDeletions Cli.respondNumbered (CantDeleteDefinitions ppeDecl combineRefs) @@ -1728,7 +1586,7 @@ displayI outputLoc hq = do (names, pped) <- if useRoot then do - root <- Cli.getRootBranch + root <- Cli.getCurrentProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names @@ -1783,27 +1641,6 @@ docsI src = do displayI ConsoleLocation (Names.longestTermName 10 (Set.findMin s) namesInFile) _ -> displayI ConsoleLocation dotDoc -loadDisplayInfo :: - Codebase m Symbol Ann -> - Set Reference -> - Sqlite.Transaction - ( [(Reference, Maybe (Type Symbol Ann))], - [(Reference, DisplayObject () (DD.Decl Symbol Ann))] - ) -loadDisplayInfo codebase refs = do - termRefs <- filterM (Codebase.isTerm codebase) (toList refs) - typeRefs <- filterM (Codebase.isType codebase) (toList refs) - terms <- forM termRefs $ \r -> (r,) <$> Codebase.getTypeOfTerm codebase r - types <- forM typeRefs $ \r -> (r,) <$> loadTypeDisplayObject codebase r - pure (terms, types) - -loadTypeDisplayObject :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (DisplayObject () (DD.Decl Symbol Ann)) -loadTypeDisplayObject codebase = \case - Reference.Builtin _ -> pure (BuiltinObject ()) - Reference.DerivedId id -> - maybe (MissingObject $ Reference.idToShortHash id) UserObject - <$> Codebase.getTypeDeclaration codebase id - lexedSource :: Text -> Text -> Cli (Text, [L.Token L.Lexeme]) lexedSource name src = do let tokens = L.lexer (Text.unpack name) (Text.unpack src) @@ -1861,14 +1698,10 @@ addWatch watchName (Just uf) = do ) _ -> addWatch watchName Nothing -looseCodeOrProjectToPath :: Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Path' -looseCodeOrProjectToPath = \case - Left pth -> pth - Right (ProjectAndBranch prj br) -> - Path.absoluteToPath' - ( ProjectUtils.projectBranchPath - ( ProjectAndBranch - (prj ^. #projectId) - (br ^. #branchId) - ) - ) +resolveBranchId2 :: BranchId2 -> Cli (Branch IO) +resolveBranchId2 = \case + Left sch -> Cli.resolveShortCausalHash sch + Right brp -> do + pp <- ProjectUtils.resolveBranchRelativePath brp + Cli.Env {codebase} <- ask + fromMaybe Branch.empty <$> liftIO (Codebase.getBranchAtProjectPath codebase pp) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs index e9d396cb29..ef96ecb983 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs @@ -19,7 +19,6 @@ import Unison.Codebase.Editor.Input (Input) import Unison.Codebase.Editor.Output (Output (NoLastRunResult, SaveTermNameConflict, SlurpOutput)) import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult -import Unison.Codebase.Path qualified as Path import Unison.CommandLine.InputPattern qualified as InputPattern import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.Name (Name) @@ -37,16 +36,16 @@ handleAddRun input resultName = do let resultVar = Name.toVar resultName uf <- addSavedTermToUnisonFile resultName Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath currentNames <- Cli.currentNames let sr = Slurp.slurpFile uf (Set.singleton resultVar) Slurp.AddOp currentNames let adds = SlurpResult.adds sr - Cli.stepAtNoSync (Path.unabsolute currentPath, doSlurpAdds adds uf) Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf + let description = (Text.pack (InputPattern.patternName InputPatterns.saveExecuteResult) <> " " <> Name.toText resultName) + pp <- Cli.getCurrentProjectPath + Cli.stepAt description (pp, doSlurpAdds adds uf) let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile uf currentNames pped <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile let suffixifiedPPE = PPE.suffixifiedPPE pped - Cli.syncRoot (Text.pack (InputPattern.patternName InputPatterns.saveExecuteResult) <> " " <> Name.toText resultName) Cli.respond $ SlurpOutput input suffixifiedPPE sr addSavedTermToUnisonFile :: Name -> Cli (TypecheckedUnisonFile Symbol Ann) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 057d6a0c26..6df6178d5a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -1,44 +1,42 @@ -- | @branch@ input handler module Unison.Codebase.Editor.HandleInput.Branch - ( handleBranch, - CreateFrom (..), - doCreateBranch, - doCreateBranch', + ( CreateFrom (..), + handleBranch, + createBranch, ) where -import Data.These (These (..)) +import Control.Monad.Reader import Data.UUID.V4 qualified as UUID import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project qualified as Sqlite +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli (getBranchAt, getCurrentPath, updateAt) +import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch) -import Unison.Codebase.Branch qualified as Branch (empty) +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, classifyProjectBranchName) import Unison.Sqlite qualified as Sqlite data CreateFrom - = CreateFrom'Branch (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) - | CreateFrom'LooseCode Path.Absolute + = CreateFrom'NamespaceWithParent Sqlite.ProjectBranch (Branch IO) + | CreateFrom'ParentBranch Sqlite.ProjectBranch + | CreateFrom'Namespace (Branch IO) | CreateFrom'Nothingness -- | Create a new project branch from an existing project branch or namespace. handleBranch :: Input.BranchSourceI -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () -handleBranch sourceI projectAndBranchNames0 = do - projectAndBranchNames@(ProjectAndBranch projectName newBranchName) <- - case projectAndBranchNames0 of - ProjectAndBranch Nothing branchName -> ProjectUtils.hydrateNames (That branchName) - ProjectAndBranch (Just projectName) branchName -> pure (ProjectAndBranch projectName branchName) - +handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newBranchName) = do -- You can only create release branches with `branch.clone` -- -- We do allow creating draft release branches with `branch`, but you'll get different output if you use @@ -50,93 +48,81 @@ handleBranch sourceI projectAndBranchNames0 = do Cli.returnEarly (Output.CannotCreateReleaseBranchWithBranchCommand newBranchName ver) ProjectBranchNameKind'NothingSpecial -> pure () + currentProjectName <- Cli.getCurrentProjectPath <&> view (#project . #name) + let projectName = (fromMaybe currentProjectName mayProjectName) + destProject <- do + Cli.runTransactionWithRollback + \rollback -> do + Queries.loadProjectByName projectName & onNothingM do + -- We can't make the *first* branch of a project with `branch`; the project has to already exist. + rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName newBranchName)) + -- Compute what we should create the branch from. - createFrom <- + maySrcProjectAndBranch <- case sourceI of - Input.BranchSourceI'CurrentContext -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> CreateFrom'LooseCode <$> Cli.getCurrentPath - Just (currentBranch, _restPath) -> pure (CreateFrom'Branch currentBranch) - Input.BranchSourceI'Empty -> pure CreateFrom'Nothingness - Input.BranchSourceI'LooseCodeOrProject (This sourcePath) -> do - currentPath <- Cli.getCurrentPath - pure (CreateFrom'LooseCode (Path.resolve currentPath sourcePath)) - Input.BranchSourceI'LooseCodeOrProject (That sourceBranch) -> - fmap CreateFrom'Branch do - ProjectUtils.expectProjectAndBranchByTheseNames - case sourceBranch of - ProjectAndBranch Nothing b -> That b - ProjectAndBranch (Just p) b -> These p b - -- For now, treat ambiguous parses as branch names, as this seems (far) more common than trying to create a - -- branch from a relative one-segment namespace. - -- - -- Future work: be smarter; for example, if there is such a relative namespace, but no such branch, maybe they - -- really meant create a branch from that namespace. - Input.BranchSourceI'LooseCodeOrProject (These _sourcePath sourceBranch) -> - fmap CreateFrom'Branch do - ProjectUtils.expectProjectAndBranchByTheseNames - case sourceBranch of - ProjectAndBranch Nothing b -> That b - ProjectAndBranch (Just p) b -> These p b - - project <- - Cli.runTransactionWithRollback \rollback -> do - Queries.loadProjectByName projectName & onNothingM do - -- We can't make the *first* branch of a project with `branch`; the project has to already exist. - rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) + Input.BranchSourceI'CurrentContext -> Just . view PP.projectAndBranch_ <$> Cli.getCurrentProjectPath + Input.BranchSourceI'Empty -> pure Nothing + Input.BranchSourceI'UnresolvedProjectBranch unresolvedProjectBranch -> do + pp <- Cli.getCurrentProjectPath + Just <$> ProjectUtils.resolveProjectBranchInProject (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just) - _ <- doCreateBranch createFrom project newBranchName ("branch " <> into @Text projectAndBranchNames) + case maySrcProjectAndBranch of + Just srcProjectAndBranch -> do + let description = "Branch created from " <> into @Text (srcProjectAndBranch & bimap (view #name) (view #name)) + void $ createBranch description (CreateFrom'ParentBranch (view #branch srcProjectAndBranch)) destProject (pure newBranchName) + Nothing -> do + let description = "Empty branch created" + void $ createBranch description CreateFrom'Nothingness destProject (pure newBranchName) Cli.respond $ Output.CreatedProjectBranch - ( case createFrom of - CreateFrom'Branch sourceBranch -> - if sourceBranch ^. #project . #projectId == project ^. #projectId + ( case maySrcProjectAndBranch of + Just sourceBranch -> + if sourceBranch ^. #project . #projectId == destProject ^. #projectId then Output.CreatedProjectBranchFrom'ParentBranch (sourceBranch ^. #branch . #name) else Output.CreatedProjectBranchFrom'OtherBranch sourceBranch - CreateFrom'LooseCode path -> Output.CreatedProjectBranchFrom'LooseCode path - CreateFrom'Nothingness -> Output.CreatedProjectBranchFrom'Nothingness + Nothing -> Output.CreatedProjectBranchFrom'Nothingness ) - projectAndBranchNames + (projectAndBranchNames & #project .~ projectName) --- | @doCreateBranch createFrom project branch description@: +-- | @createBranch description createFrom project getNewBranchName@: -- --- 1. Creates a new branch row for @branch@ in project @project@ (failing if @branch@ already exists in @project@) --- 2. Puts the branch contents from @createFrom@ in the root namespace., using @description@ for the reflog. --- 3. cds to the new branch in the root namespace. +-- 1. Creates a new branch row in @project@ at the name from @getNewBranchName@ (failing if branch already exists in @project@). +-- 2. Switches to the new branch. -- -- This bit of functionality is factored out from the main 'handleBranch' handler because it is also called by the -- @release.draft@ command, which essentially just creates a branch, but with some different output for the user. -- --- Returns the branch id of the newly-created branch. -doCreateBranch :: CreateFrom -> Sqlite.Project -> ProjectBranchName -> Text -> Cli ProjectBranchId -doCreateBranch createFrom project newBranchName description = do - sourceNamespaceObject <- - case createFrom of - CreateFrom'Branch (ProjectAndBranch _ sourceBranch) -> do - let sourceProjectId = sourceBranch ^. #projectId - let sourceBranchId = sourceBranch ^. #branchId - Cli.getBranchAt (ProjectUtils.projectBranchPath (ProjectAndBranch sourceProjectId sourceBranchId)) - CreateFrom'LooseCode sourcePath -> Cli.getBranchAt sourcePath - CreateFrom'Nothingness -> pure Branch.empty - let parentBranchId = - case createFrom of - CreateFrom'Branch (ProjectAndBranch _ sourceBranch) - | sourceBranch.projectId == project.projectId -> Just sourceBranch.branchId - _ -> Nothing - (newBranchId, _) <- doCreateBranch' sourceNamespaceObject parentBranchId project (pure newBranchName) description - pure newBranchId - -doCreateBranch' :: - Branch IO -> - Maybe ProjectBranchId -> +-- Returns the branch id and name of the newly-created branch. +createBranch :: + Text -> + CreateFrom -> Sqlite.Project -> Sqlite.Transaction ProjectBranchName -> - Text -> Cli (ProjectBranchId, ProjectBranchName) -doCreateBranch' sourceNamespaceObject parentBranchId project getNewBranchName description = do +createBranch description createFrom project getNewBranchName = do let projectId = project ^. #projectId - (newBranchId, newBranchName) <- + Cli.Env {codebase} <- ask + (mayParentBranchId, newBranchCausalHashId) <- case createFrom of + CreateFrom'ParentBranch parentBranch -> Cli.runTransaction do + newBranchCausalHashId <- Q.expectProjectBranchHead parentBranch.projectId parentBranch.branchId + let parentBranchId = if parentBranch.projectId == projectId then Just parentBranch.branchId else Nothing + pure (parentBranchId, newBranchCausalHashId) + CreateFrom'Nothingness -> Cli.runTransaction do + (_, causalHashId) <- Codebase.emptyCausalHash + pure (Nothing, causalHashId) + CreateFrom'NamespaceWithParent parentBranch namespace -> do + liftIO $ Codebase.putBranch codebase namespace + Cli.runTransaction $ do + newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash namespace) + let parentBranchId = if parentBranch.projectId == projectId then Just parentBranch.branchId else Nothing + pure (parentBranchId, newBranchCausalHashId) + CreateFrom'Namespace branch -> do + liftIO $ Codebase.putBranch codebase branch + Cli.runTransaction $ do + newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash branch) + pure (Nothing, newBranchCausalHashId) + (newBranchName, newBranchId) <- Cli.runTransactionWithRollback \rollback -> do newBranchName <- getNewBranchName Queries.projectBranchExistsByName projectId newBranchName >>= \case @@ -146,16 +132,15 @@ doCreateBranch' sourceNamespaceObject parentBranchId project getNewBranchName de -- `bar`, so the fork will succeed. newBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) Queries.insertProjectBranch + description + newBranchCausalHashId Sqlite.ProjectBranch { projectId, branchId = newBranchId, name = newBranchName, - parentBranchId = parentBranchId + parentBranchId = mayParentBranchId } - Queries.setMostRecentBranch projectId newBranchId - pure (newBranchId, newBranchName) + pure (newBranchName, newBranchId) - let newBranchPath = ProjectUtils.projectBranchPath (ProjectAndBranch projectId newBranchId) - _ <- Cli.updateAt description newBranchPath (const sourceNamespaceObject) - Cli.cd newBranchPath + Cli.switchProject (ProjectAndBranch projectId newBranchId) pure (newBranchId, newBranchName) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs index cc73936683..fdb5bdf6c8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs @@ -7,14 +7,15 @@ where import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase.Editor.Output qualified as Output +import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), classifyProjectBranchName) handleBranchRename :: ProjectBranchName -> Cli () handleBranchRename newBranchName = do - (ProjectAndBranch project branch, _path) <- ProjectUtils.expectCurrentProjectBranch + PP.ProjectPath project branch _path <- Cli.getCurrentProjectPath case classifyProjectBranchName newBranchName of ProjectBranchNameKind'Contributor {} -> pure () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs index ba7bf5c885..99381ea7c6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs @@ -10,14 +10,14 @@ import Network.URI (URI) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude -import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Project (ProjectBranchName, ProjectName) handleBranches :: Maybe ProjectName -> Cli () handleBranches maybeProjectName = do - maybeCurrentProjectIds <- ProjectUtils.getCurrentProjectIds + pp <- Cli.getCurrentProjectPath (project, branches) <- Cli.runTransactionWithRollback \rollback -> do project <- @@ -26,8 +26,7 @@ handleBranches maybeProjectName = do Queries.loadProjectByName projectName & onNothingM do rollback (Output.LocalProjectDoesntExist projectName) Nothing -> do - ProjectAndBranch projectId _ <- maybeCurrentProjectIds & onNothing (rollback Output.NotOnProjectBranch) - Queries.expectProject projectId + pure (pp ^. #project) branches <- Queries.loadAllProjectBranchInfo (project ^. #projectId) pure (project, branches) Cli.respondNumbered (Output.ListBranches (project ^. #name) (f branches)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs index 9631295219..62c46b2b5d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs @@ -9,6 +9,7 @@ import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge @@ -21,7 +22,7 @@ import Unison.Project (ProjectAndBranch (..)) handleCommitMerge :: Cli () handleCommitMerge = do - (mergeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch + mergeProjectAndBranch <- Cli.getCurrentProjectAndBranch -- Assert that this is a "merge" branch, get its parent (which is the branch we were on when we ran `merge`), -- and switch to the parent. @@ -33,9 +34,8 @@ handleCommitMerge = do parentBranch <- Cli.runTransaction do parentBranch <- Queries.expectProjectBranch mergeProjectAndBranch.project.projectId parentBranchId - Queries.setMostRecentBranch parentBranch.projectId parentBranch.branchId pure parentBranch - Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch parentBranch.projectId parentBranch.branchId)) + Cli.switchProject (ProjectAndBranch parentBranch.projectId parentBranch.branchId) -- Merge the merge branch into the parent diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs index a7d61a8cdb..93d1188830 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -9,6 +9,7 @@ import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge @@ -21,7 +22,7 @@ import Unison.Project (ProjectAndBranch (..)) handleCommitUpgrade :: Cli () handleCommitUpgrade = do - (upgradeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch + upgradeProjectAndBranch <- Cli.getCurrentProjectAndBranch -- Assert that this is an "upgrade" branch, get its parent (which is the branch we were on when we ran `upgrade`), -- and switch to the parent. @@ -33,9 +34,8 @@ handleCommitUpgrade = do parentBranch <- Cli.runTransaction do parentBranch <- Queries.expectProjectBranch upgradeProjectAndBranch.project.projectId parentBranchId - Queries.setMostRecentBranch parentBranch.projectId parentBranch.branchId pure parentBranch - Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch parentBranch.projectId parentBranch.branchId)) + Cli.switchProject (ProjectAndBranch parentBranch.projectId parentBranch.branchId) -- Merge the upgrade branch into the parent diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs new file mode 100644 index 0000000000..2e4144c06d --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs @@ -0,0 +1,65 @@ +-- | @debug.synhash.term@ input handler. +module Unison.Codebase.Editor.HandleInput.DebugSynhashTerm + ( handleDebugSynhashTerm, + ) +where + +import Control.Monad.Reader (ask) +import Data.Text qualified as Text +import Data.Text.IO qualified as Text +import U.Util.Base32Hex qualified as Base32Hex +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.Pretty (prettyBase32Hex, prettyHash) +import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.Output (Output (..)) +import Unison.Hash (Hash) +import Unison.Hashable qualified as Hashable +import Unison.Merge.Synhash (hashBuiltinTermTokens, hashDerivedTermTokens) +import Unison.Name (Name) +import Unison.Names qualified as Names +import Unison.Prelude +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.Reference qualified as Reference +import Unison.Syntax.Name qualified as Name +import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty qualified as Pretty + +handleDebugSynhashTerm :: Name -> Cli () +handleDebugSynhashTerm name = do + namespace <- Cli.getCurrentBranch0 + let names = Branch.toNames namespace + pped <- Cli.prettyPrintEnvDeclFromNames names + + for_ (Names.refTermsNamed names name) \ref -> do + maybeTokens <- + case ref of + Reference.Builtin builtin -> pure (Just (hashBuiltinTermTokens builtin)) + Reference.DerivedId refId -> do + env <- ask + Cli.runTransaction (Codebase.getTerm env.codebase refId) <&> \case + Nothing -> Nothing + Just term -> Just (hashDerivedTermTokens pped.unsuffixifiedPPE term) + whenJust maybeTokens \tokens -> do + let filename = Name.toText name <> "-" <> Reference.toText ref <> "-synhash-tokens.txt" + let renderedTokens = + tokens + & map prettyToken + & Pretty.lines + & Pretty.toAnsiUnbroken + & Text.pack + liftIO (Text.writeFile (Text.unpack filename) renderedTokens) + Cli.respond (Output'DebugSynhashTerm ref (Hashable.accumulate tokens) filename) + +prettyToken :: Hashable.Token Hash -> Pretty ColorText +prettyToken = \case + Hashable.Bytes bytes -> "0x" <> prettyBase32Hex (Base32Hex.fromByteString bytes) + Hashable.Double n -> Pretty.string (show n) + Hashable.Hashed h -> prettyHash h + Hashable.Int n -> (if n >= 0 then "+" else mempty) <> Pretty.string (show n) + Hashable.Nat n -> Pretty.string (show n) + Hashable.Tag n -> "@" <> Pretty.string (show n) + Hashable.Text s -> Pretty.string (show s) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index 72df1028fd..ccbcfcb267 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -5,19 +5,26 @@ module Unison.Codebase.Editor.HandleInput.DeleteBranch ) where -import Data.Map.Strict qualified as Map -import Data.These (These (..)) +import Control.Lens +import Data.List qualified as List +import U.Codebase.Sqlite.DbId +import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.Project qualified as Sqlite +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Path qualified as Path +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.HandleInput.ProjectCreate +import Unison.Codebase.ProjectPath (ProjectPathG (..)) +import Unison.Codebase.SqliteCodebase.Operations qualified as Ops +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.Prelude -import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Project (ProjectAndBranch (..)) +import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) -- | Delete a project branch. @@ -27,44 +34,64 @@ import Witch (unsafeFrom) -- project. handleDeleteBranch :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleDeleteBranch projectAndBranchNamesToDelete = do - projectAndBranchToDelete <- - ProjectUtils.expectProjectAndBranchByTheseNames - case projectAndBranchNamesToDelete of - ProjectAndBranch Nothing branch -> That branch - ProjectAndBranch (Just project) branch -> These project branch - - maybeCurrentBranch <- ProjectUtils.getCurrentProjectBranch - - doDeleteProjectBranch projectAndBranchToDelete + ProjectPath currentProject currentBranch _ <- Cli.getCurrentProjectPath + projectAndBranchToDelete@(ProjectAndBranch projectOfBranchToDelete branchToDelete) <- ProjectUtils.resolveProjectBranchInProject currentProject (projectAndBranchNamesToDelete & #branch %~ Just) -- If the user is on the branch that they're deleting, we have to cd somewhere; try these in order: -- -- 1. cd to parent branch, if it exists -- 2. cd to "main", if it exists - -- 3. cd to loose code path `.` - whenJust maybeCurrentBranch \(currentProjectAndBranch, _restPath) -> - when (ProjectUtils.justTheIds currentProjectAndBranch == ProjectUtils.justTheIds projectAndBranchToDelete) do - newPath <- - case projectAndBranchToDelete.branch.parentBranchId of - Nothing -> - let loadMain = - Queries.loadProjectBranchByName projectAndBranchToDelete.project.projectId (unsafeFrom @Text "main") - in Cli.runTransaction loadMain <&> \case - Nothing -> Path.Absolute Path.empty - Just mainBranch -> ProjectUtils.projectBranchPath (ProjectUtils.justTheIds' mainBranch) - Just parentBranchId -> - pure $ - ProjectUtils.projectBranchPath - (ProjectAndBranch projectAndBranchToDelete.project.projectId parentBranchId) - Cli.cd newPath + -- 3. Any other branch in the codebase + -- 4. Create a new branch in the current project + when (branchToDelete ^. #branchId == currentBranch ^. #branchId) do + mayNextLocation <- + Cli.runTransaction . runMaybeT $ + asum + [ parentBranch (branchToDelete ^. #projectId) (branchToDelete ^. #parentBranchId), + findMainBranchInProjectExcept (currentProject ^. #projectId) (branchToDelete ^. #branchId), + -- Any branch in the codebase except the one we're deleting + findAnyBranchInProjectExcept (branchToDelete ^. #projectId) (branchToDelete ^. #branchId), + findAnyBranchInCodebaseExcept (branchToDelete ^. #projectId) (branchToDelete ^. #branchId), + createNewBranchInProjectExcept projectOfBranchToDelete.name branchToDelete.name + ] + + nextLoc <- mayNextLocation `whenNothing` projectCreate False Nothing + Cli.switchProject nextLoc + doDeleteProjectBranch projectAndBranchToDelete + where + parentBranch :: ProjectId -> Maybe ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + parentBranch projectId mayParentBranchId = do + parentBranchId <- hoistMaybe mayParentBranchId + pure (ProjectAndBranch projectId parentBranchId) + + findMainBranchInProjectExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findMainBranchInProjectExcept projectId exceptBranchId = do + branch <- MaybeT $ Queries.loadProjectBranchByName projectId (unsafeFrom @Text "main") + guard (branch ^. #branchId /= exceptBranchId) + pure (ProjectAndBranch projectId (branch ^. #branchId)) + + findAnyBranchInProjectExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findAnyBranchInProjectExcept projectId exceptBranchId = do + (someBranchId, _) <- MaybeT . fmap (List.find (\(branchId, _) -> branchId /= exceptBranchId)) $ Queries.loadAllProjectBranchesBeginningWith projectId Nothing + pure (ProjectAndBranch projectId someBranchId) + + findAnyBranchInCodebaseExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findAnyBranchInCodebaseExcept exceptProjectId exceptBranchId = do + (_, pbIds) <- MaybeT . fmap (List.find (\(_, ids) -> ids /= ProjectAndBranch exceptProjectId exceptBranchId)) $ Queries.loadAllProjectBranchNamePairs + pure pbIds + + createNewBranchInProjectExcept :: ProjectName -> ProjectBranchName -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + createNewBranchInProjectExcept projectName (UnsafeProjectBranchName "main") = lift $ do + (_, emptyCausalHashId) <- Codebase.emptyCausalHash + Ops.insertProjectAndBranch projectName (UnsafeProjectBranchName "main2") emptyCausalHashId + <&> \(proj, branch) -> ProjectAndBranch proj.projectId branch.branchId + createNewBranchInProjectExcept projectName _ = lift $ do + (_, emptyCausalHashId) <- Codebase.emptyCausalHash + Ops.insertProjectAndBranch projectName (UnsafeProjectBranchName "main") emptyCausalHashId + <&> \(proj, branch) -> ProjectAndBranch proj.projectId branch.branchId -- | Delete a project branch and record an entry in the reflog. -doDeleteProjectBranch :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli () +doDeleteProjectBranch :: (HasCallStack) => ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli () doDeleteProjectBranch projectAndBranch = do Cli.runTransaction do Queries.deleteProjectBranch projectAndBranch.project.projectId projectAndBranch.branch.branchId - Cli.stepAt - ("delete.branch " <> into @Text (ProjectUtils.justTheNames projectAndBranch)) - ( Path.unabsolute (ProjectUtils.projectBranchesPath projectAndBranch.project.projectId), - over Branch.children (Map.delete (ProjectUtils.projectBranchSegment projectAndBranch.branch.branchId)) - ) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs index 3ff51cf818..ee662c91ad 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs @@ -4,39 +4,53 @@ module Unison.Codebase.Editor.HandleInput.DeleteProject ) where -import Data.Function (on) +import Control.Lens +import Data.List qualified as List +import U.Codebase.Sqlite.DbId +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) +import Unison.Codebase.SqliteCodebase.Operations qualified as Ops +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.Prelude -import Unison.Project (ProjectAndBranch (..), ProjectName) +import Unison.Project (ProjectAndBranch (..)) +import Unison.Sqlite qualified as Sqlite -- | Delete a project handleDeleteProject :: ProjectName -> Cli () handleDeleteProject projectName = do - maybeCurrentBranch <- ProjectUtils.getCurrentProjectBranch + ProjectPath currentProject _ _ <- Cli.getCurrentProjectPath - deletedProject <- + projectToDelete <- Cli.runTransactionWithRollback \rollback -> do - project <- - Queries.loadProjectByName projectName & onNothingM do - rollback (Output.LocalProjectDoesntExist projectName) - Queries.deleteProject (project ^. #projectId) - pure project + Queries.loadProjectByName projectName & onNothingM do + rollback (Output.LocalProjectDoesntExist projectName) - let projectId = deletedProject ^. #projectId + when (projectToDelete.projectId == currentProject.projectId) do + nextLoc <- Cli.runTransaction $ findAnyBranchInCodebaseNotInProject (projectToDelete.projectId) `whenNothingM` createDummyProjectExcept projectToDelete.name + Cli.switchProject nextLoc - Cli.updateAt - ("delete.project " <> into @Text projectName) - (ProjectUtils.projectPath projectId) - (const Branch.empty) + Cli.runTransaction do + Queries.deleteProject (projectToDelete ^. #projectId) + where + findAnyBranchInCodebaseNotInProject :: ProjectId -> Sqlite.Transaction (Maybe (ProjectAndBranch ProjectId ProjectBranchId)) + findAnyBranchInCodebaseNotInProject exceptProjectId = do + Queries.loadAllProjectBranchNamePairs + <&> List.find (\(_, ProjectAndBranch projId _) -> projId /= exceptProjectId) + <&> fmap \(_, pbIds) -> pbIds - -- If the user is on the project that they're deleting, we cd to the root path - whenJust maybeCurrentBranch \(ProjectAndBranch currentProject _currentBranch, _restPath) -> - when (on (==) (view #projectId) deletedProject currentProject) do - Cli.cd (Path.Absolute Path.empty) + createDummyProjectExcept :: ProjectName -> Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + createDummyProjectExcept (UnsafeProjectName "scratch") = do + (_, emptyCausalHashId) <- Codebase.emptyCausalHash + Ops.insertProjectAndBranch (UnsafeProjectName "scratch2") (UnsafeProjectBranchName "main") emptyCausalHashId + <&> \(proj, branch) -> ProjectAndBranch proj.projectId branch.branchId + createDummyProjectExcept _ = do + (_, emptyCausalHashId) <- Codebase.emptyCausalHash + Ops.insertProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main") emptyCausalHashId + <&> \(proj, branch) -> ProjectAndBranch proj.projectId branch.branchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs index 45fb100a44..6a46205240 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs @@ -20,7 +20,7 @@ import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs index fde32e2235..e0f2cf4294 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs @@ -39,7 +39,7 @@ import Unison.Var qualified as Var -- | Format a file, returning a list of Text replacements to apply to the file. formatFile :: - Monad m => + (Monad m) => (Maybe (UnisonFile Symbol Ann.Ann) -> Maybe (TypecheckedUnisonFile Symbol Ann.Ann) -> m PPED.PrettyPrintEnvDecl) -> Int -> Path.Absolute -> @@ -197,7 +197,7 @@ annToInterval ann = annToRange ann <&> rangeToInterval -- | Returns 'True' if the given symbol is a term with a user provided type signature in the -- parsed file, false otherwise. -hasUserTypeSignature :: Eq v => UnisonFile v a -> v -> Bool +hasUserTypeSignature :: (Eq v) => UnisonFile v a -> v -> Bool hasUserTypeSignature parsedFile sym = Map.toList (UF.terms parsedFile) & any (\(v, (_, trm)) -> v == sym && isJust (Term.getTypeAnnotation trm)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index 4c30120170..52e70188c8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -10,8 +10,6 @@ import Data.Map.Strict qualified as Map import Data.Maybe (fromJust) import Data.Set qualified as Set import Data.Text qualified as Text -import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..)) -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch (..)) import Unison.Cli.DownloadUtils import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -22,6 +20,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Core.Project (ProjectBranchName) import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (libSegment) @@ -40,14 +39,6 @@ import Unison.Syntax.NameSegment qualified as NameSegment (unsafeParseText) handleInstallLib :: Bool -> ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease) -> Cli () handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) = do - (currentProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch - - let currentProjectBranchPath = - ProjectUtils.projectBranchPath $ - ProjectAndBranch - currentProjectAndBranch.project.projectId - currentProjectAndBranch.branch.branchId - libdepProject <- ProjectUtils.expectRemoteProjectByName libdepProjectName libdepBranchName <- @@ -79,7 +70,7 @@ handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBran -- -- For example, if the best name is "foo", and libdeps "foo" and "foo__2" already exist, then we'll get "foo__3". libdepNameSegment :: NameSegment <- do - currentBranchObject <- Cli.getBranch0At currentProjectBranchPath + currentBranchObject <- Cli.getCurrentProjectRoot0 pure $ fresh (\i -> NameSegment.unsafeParseText . (<> "__" <> tShow i) . NameSegment.toUnescapedText) @@ -90,13 +81,12 @@ handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBran (makeDependencyName libdepProjectName libdepBranchName) let libdepPath :: Path.Absolute - libdepPath = - Path.resolve - currentProjectBranchPath - (Path.Relative (Path.fromList [NameSegment.libSegment, libdepNameSegment])) + libdepPath = Path.Absolute $ Path.fromList [NameSegment.libSegment, libdepNameSegment] let reflogDescription = "lib.install " <> into @Text libdepProjectAndBranchNames - _didUpdate <- Cli.updateAt reflogDescription libdepPath (\_empty -> remoteBranchObject) + pp <- Cli.getCurrentProjectPath + let libDepPP = pp & PP.absPath_ .~ libdepPath + _didUpdate <- Cli.updateAt reflogDescription libDepPP (\_empty -> remoteBranchObject) Cli.respond (Output.InstalledLibdep libdepProjectAndBranchNames libdepNameSegment) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs new file mode 100644 index 0000000000..dc4f0cc14d --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs @@ -0,0 +1,15 @@ +module Unison.Codebase.Editor.HandleInput.LSPDebug (debugLspNameCompletion) where + +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli +import Unison.Codebase.Editor.Output (Output (DisplayDebugLSPNameCompletions)) +import Unison.LSP.Completion qualified as Completion +import Unison.Prelude + +debugLspNameCompletion :: Text -> Cli () +debugLspNameCompletion prefix = do + names <- Cli.currentNames + let ct = Completion.namesToCompletionTree names + let (_, matches) = Completion.completionsForQuery ct prefix + Cli.respond $ DisplayDebugLSPNameCompletions matches diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index a9259fc969..ce5e1aa993 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -40,7 +40,9 @@ import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Term qualified as Term import Unison.UnisonFile (TypecheckedUnisonFile) +import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Timing qualified as Timing import Unison.WatchKind qualified as WK handleLoad :: Maybe FilePath -> Cli () @@ -65,11 +67,14 @@ loadUnisonFile sourceName text = do pped <- Cli.prettyPrintEnvDeclFromNames names let ppe = PPE.suffixifiedPPE pped Cli.respond $ Output.Typechecked sourceName ppe sr unisonFile - (bindings, e) <- evalUnisonFile Permissive ppe unisonFile [] - let e' = Map.map go e - go (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit) - when (not (null e')) do - Cli.respond $ Output.Evaluated text ppe bindings e' + + when (not . null $ UF.watchComponents unisonFile) do + Timing.time "evaluating watches" do + (bindings, e) <- evalUnisonFile Permissive ppe unisonFile [] + let e' = Map.map go e + go (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit) + when (not (null e')) do + Cli.respond $ Output.Evaluated text ppe bindings e' #latestTypecheckedFile .= Just (Right unisonFile) where withFile :: @@ -78,17 +83,17 @@ loadUnisonFile sourceName text = do Text -> Cli (TypecheckedUnisonFile Symbol Ann) withFile names sourceName text = do - currentPath <- Cli.getCurrentPath + pp <- Cli.getCurrentProjectPath State.modify' \loopState -> loopState - & #latestFile .~ Just (Text.unpack sourceName, False) - & #latestTypecheckedFile .~ Nothing + & (#latestFile .~ Just (Text.unpack sourceName, False)) + & (#latestTypecheckedFile .~ Nothing) Cli.Env {codebase, generateUniqueName} <- ask uniqueName <- liftIO generateUniqueName let parsingEnv = Parser.ParsingEnv { uniqueNames = uniqueName, - uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath, + uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, names } unisonFile <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs new file mode 100644 index 0000000000..55be69f3a7 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs @@ -0,0 +1,35 @@ +module Unison.Codebase.Editor.HandleInput.Ls + ( handleLs, + ) +where + +import Control.Monad.Reader (ask) +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.Output +import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.Codebase.Path (Path') +import Unison.Codebase.ProjectPath (ProjectPathG (..)) +import Unison.Prelude +import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.Server.Backend qualified as Backend + +handleLs :: Path' -> Cli () +handleLs pathArg = do + Cli.Env {codebase} <- ask + pp <- Cli.resolvePath' pathArg + projectRootBranch <- Cli.runTransaction $ Codebase.expectShallowProjectBranchRoot pp.branch + entries <- liftIO (Backend.lsAtPath codebase projectRootBranch (pp.absPath)) + Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries + pped <- Cli.currentPrettyPrintEnvDecl + let suffixifiedPPE = PPED.suffixifiedPPE pped + -- This used to be a delayed action which only forced the loading of the root + -- branch when it was necessary for printing the results, but that got wiped out + -- when we ported to the new Cli monad. + -- It would be nice to restore it, but it's pretty rare that it actually results + -- in an improvement, so perhaps it's not worth the effort. + let buildPPE = pure suffixifiedPPE + Cli.respond $ ListShallow buildPPE entries diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index ceee0aa836..eca5b5158a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -1,3 +1,4 @@ +-- | @merge@ input handler. module Unison.Codebase.Editor.HandleInput.Merge2 ( handleMerge, @@ -8,6 +9,9 @@ module Unison.Codebase.Editor.HandleInput.Merge2 LcaMergeInfo (..), doMerge, doMergeLocalBranch, + + -- * API exported for @todo@ + hasDefnsInLib, ) where @@ -65,6 +69,8 @@ import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.RemoteRepo (ReadShareLooseCode (..)) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations @@ -74,7 +80,7 @@ import Unison.Debug qualified as Debug import Unison.Hash (Hash) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency) @@ -85,6 +91,7 @@ import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) import Unison.Merge.EitherWayI qualified as EitherWayI import Unison.Merge.Libdeps qualified as Merge +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.Synhashed qualified as Synhashed @@ -113,7 +120,7 @@ import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNa import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent' +import Unison.ReferentPrime qualified as Referent' import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Unison.Syntax.DeclPrinter (AccessorName) @@ -138,12 +145,12 @@ import Unison.Util.SyntaxText (SyntaxText') import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) -import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do -- Assert that Alice (us) is on a project branch, and grab the causal hash. - (aliceProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch + ProjectPath aliceProject aliceProjectBranch _path <- Cli.getCurrentProjectPath + let aliceProjectAndBranch = ProjectAndBranch aliceProject aliceProjectBranch -- Resolve Bob's maybe-project-name + branch-name to the info the merge algorithm needs: the project name, branch -- name, and causal hash. @@ -193,7 +200,6 @@ doMerge info = do then realDebugFunctions else fakeDebugFunctions - let alicePath = ProjectUtils.projectBranchPath (ProjectUtils.justTheIds info.alice.projectAndBranch) let aliceBranchNames = ProjectUtils.justTheNames info.alice.projectAndBranch let mergeSource = MergeSourceOrTarget'Source info.bob.source let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames @@ -210,7 +216,7 @@ doMerge info = do -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. when (info.lca.causalHash == Just info.alice.causalHash) do bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) - _ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch) + _ <- Cli.updateAt info.description (PP.projectBranchRoot info.alice.projectAndBranch) (\_aliceBranch -> bobBranch) done (Output.MergeSuccessFastForward mergeSourceAndTarget) -- Create a bunch of cached database lookup functions @@ -238,11 +244,7 @@ doMerge info = do -- Assert that neither Alice nor Bob have defns in lib for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do - libdeps <- - case Map.lookup NameSegment.libSegment branch.children of - Nothing -> pure V2.Branch.empty - Just libdeps -> Cli.runTransaction libdeps.value - when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do + whenM (Cli.runTransaction (hasDefnsInLib branch)) do done (Output.MergeDefnsInLib who) -- Load Alice/Bob/LCA definitions and decl name lookups @@ -397,7 +399,7 @@ doMerge info = do in if thisMergeHasConflicts then pure Nothing else do - currentPath <- Cli.getCurrentPath + currentPath <- Cli.getCurrentProjectPath parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch) prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe @@ -408,12 +410,12 @@ doMerge info = do Nothing -> do Cli.Env {writeSource} <- ask (_temporaryBranchId, temporaryBranchName) <- - HandleInput.Branch.doCreateBranch' - (Branch.mergeNode stageOneBranch parents.alice parents.bob) - (Just info.alice.projectAndBranch.branch.branchId) + HandleInput.Branch.createBranch + info.description + (HandleInput.Branch.CreateFrom'NamespaceWithParent info.alice.projectAndBranch.branch (Branch.mergeNode stageOneBranch parents.alice parents.bob)) info.alice.projectAndBranch.project (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) - info.description + scratchFilePath <- Cli.getLatestFile <&> \case Nothing -> "scratch.u" @@ -423,11 +425,10 @@ doMerge info = do Just tuf -> do Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch - _ <- - Cli.updateAt - info.description - alicePath - (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) + Cli.updateProjectBranchRoot_ + info.alice.projectAndBranch.branch + info.description + (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) pure (Output.MergeSuccess mergeSourceAndTarget) Cli.respond finalOutput @@ -436,8 +437,8 @@ doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do (aliceCausalHash, bobCausalHash, lcaCausalHash) <- Cli.runTransaction do - aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.alice) - bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.bob) + aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (branches.alice ^. #branch) + bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (branches.bob ^. #branch) -- Using Alice and Bob's causal hashes, find the LCA (if it exists) lcaCausalHash <- Operations.lca aliceCausalHash bobCausalHash pure (aliceCausalHash, bobCausalHash, lcaCausalHash) @@ -485,6 +486,17 @@ loadLibdeps branches = do libdepsBranch <- libdepsCausal.value pure libdepsBranch.children +------------------------------------------------------------------------------------------------------------------------ +-- Merge precondition violation checks + +hasDefnsInLib :: (Applicative m) => V2.Branch m -> m Bool +hasDefnsInLib branch = do + libdeps <- + case Map.lookup NameSegment.libSegment branch.children of + Nothing -> pure V2.Branch.empty + Just libdeps -> libdeps.value + pure (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) + ------------------------------------------------------------------------------------------------------------------------ -- Creating Unison files diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs index 77b4bc8514..d7b926e8fe 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs @@ -8,7 +8,7 @@ import Unison.Codebase.Editor.HandleInput.MoveTerm (moveTermSteps) import Unison.Codebase.Editor.HandleInput.MoveType (moveTypeSteps) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Prelude handleMoveAll :: Bool -> Path.Path' -> Path.Path' -> Text -> Cli () @@ -23,5 +23,6 @@ handleMoveAll hasConfirmed src' dest' description = do case (moveBranchFunc, moveTermTypeSteps) of (Nothing, []) -> Cli.respond (Output.MoveNothingFound src') (mupdates, steps) -> do - Cli.updateAndStepAt description (maybeToList mupdates) steps + pp <- Cli.getCurrentProjectPath + Cli.updateAndStepAt description (pp ^. #branch) (maybeToList mupdates) steps Cli.respond Output.Success diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs index 21b41511b0..eb6b3effbf 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs @@ -7,17 +7,21 @@ import Unison.Codebase.Branch (Branch) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Output (Output (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude +-- | Note: Currently only allows moving within the same project-branch, should be easy to change in the future if +-- needed. moveBranchFunc :: Bool -> Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO)) moveBranchFunc hasConfirmed src' dest' = do - srcAbs <- Cli.resolvePath' src' - destAbs <- Cli.resolvePath' dest' + -- We currently only support moving within the same project branch. + srcPP@(PP.ProjectPath _proj _projBranch srcAbs) <- Cli.resolvePath' src' + PP.ProjectPath _ _ destAbs <- Cli.resolvePath' dest' destBranchExists <- Cli.branchExistsAtPath' dest' let isRootMove = (Path.isRoot srcAbs || Path.isRoot destAbs) when (isRootMove && not hasConfirmed) do Cli.returnEarly MoveRootBranchConfirmation - Cli.getMaybeBranchAt srcAbs >>= traverse \srcBranch -> do + Cli.getMaybeBranchFromProjectPath srcPP >>= traverse \srcBranch -> do -- We want the move to appear as a single step in the root namespace, but we need to make -- surgical changes in both the root and the destination, so we make our modifications at the shared parent of -- those changes such that they appear as a single change in the root. @@ -37,6 +41,7 @@ doMoveBranch :: Text -> Bool -> Path.Path' -> Path.Path' -> Cli () doMoveBranch actionDescription hasConfirmed src' dest' = do moveBranchFunc hasConfirmed src' dest' >>= \case Nothing -> Cli.respond (BranchNotFound src') - Just (path, func) -> do - _ <- Cli.updateAt actionDescription path func + Just (absPath, func) -> do + pp <- Cli.resolvePath' (Path.AbsolutePath' absPath) + _ <- Cli.updateAt actionDescription pp func Cli.respond Success diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs index c329060303..e8dbde0229 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm, moveTermSteps) where -import Control.Lens (_2) +import Control.Lens (_1, _2) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -9,13 +9,14 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.Codebase.ProjectPath qualified as PP +import Unison.HashQualifiedPrime qualified as HQ' import Unison.NameSegment (NameSegment) import Unison.Prelude -moveTermSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path, Branch0 m -> Branch0 m)] +moveTermSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path.Absolute, Branch0 m -> Branch0 m)] moveTermSteps src' dest' = do src <- Cli.resolveSplit' src' srcTerms <- Cli.getTermsAt src @@ -29,11 +30,11 @@ moveTermSteps src' dest' = do destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest) when (not (Set.null destTerms)) do Cli.returnEarly (Output.TermAlreadyExists dest' destTerms) - let p = first Path.unabsolute src + let p = src & _1 %~ view PP.absPath_ pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTermName (over _2 HQ'.toName p) srcTerm, - BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm + BranchUtil.makeAddTermName (over _1 (view PP.absPath_) dest) srcTerm ] doMoveTerm :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli () @@ -41,5 +42,6 @@ doMoveTerm src' dest' description = do steps <- moveTermSteps src' dest' when (null steps) do Cli.returnEarly (Output.TermNotFound src') - Cli.stepManyAt description steps + pb <- Cli.getCurrentProjectBranch + Cli.stepManyAt pb description steps Cli.respond Output.Success diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs index bdf9fe88cd..9c6125c205 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveType (doMoveType, moveTypeSteps) where -import Control.Lens (_2) +import Control.Lens (_1, _2) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -9,13 +9,14 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.Codebase.ProjectPath qualified as PP +import Unison.HashQualifiedPrime qualified as HQ' import Unison.NameSegment (NameSegment) import Unison.Prelude -moveTypeSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path, Branch0 m -> Branch0 m)] +moveTypeSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path.Absolute, Branch0 m -> Branch0 m)] moveTypeSteps src' dest' = do src <- Cli.resolveSplit' src' srcTypes <- Cli.getTypesAt src @@ -29,11 +30,11 @@ moveTypeSteps src' dest' = do destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest) when (not (Set.null destTypes)) do Cli.returnEarly (Output.TypeAlreadyExists dest' destTypes) - let p = first Path.unabsolute src + let p = over _1 (view PP.absPath_) src pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTypeName (over _2 HQ'.toName p) srcType, - BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType + BranchUtil.makeAddTypeName (over _1 (view PP.absPath_) dest) srcType ] doMoveType :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli () @@ -41,5 +42,6 @@ doMoveType src' dest' description = do steps <- moveTypeSteps src' dest' when (null steps) do Cli.returnEarly (Output.TypeNotFound src') - Cli.stepManyAt description steps + pb <- Cli.getCurrentProjectBranch + Cli.stepManyAt pb description steps Cli.respond Output.Success diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index 068a28832b..aa35d39dde 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -14,7 +14,6 @@ import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path import Unison.DataDeclaration qualified as DD @@ -22,7 +21,6 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.NameSegment qualified as NameSegment -import Unison.Names qualified as Names import Unison.Prelude import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.Reference qualified as Reference @@ -35,19 +33,16 @@ import Unison.Util.Relation qualified as Relation handleNamespaceDependencies :: Maybe Path.Path' -> Cli.Cli () handleNamespaceDependencies namespacePath' = do Cli.Env {codebase} <- ask - path <- maybe Cli.getCurrentPath Cli.resolvePath' namespacePath' + pp <- maybe Cli.getCurrentProjectPath Cli.resolvePath' namespacePath' + let pb = pp ^. #branch branch <- - Cli.getMaybeBranch0At path & onNothingM do - Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath (Path.absoluteToPath' path))) + Cli.getMaybeBranch0FromProjectPath pp & onNothingM do + Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath pp)) externalDependencies <- Cli.runTransaction (namespaceDependencies codebase branch) - currentPPED <- Cli.currentPrettyPrintEnvDecl - globalNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getRootBranch0 - globalPPED <- Cli.prettyPrintEnvDeclFromNames globalNames - -- We explicitly include a global unsuffixified fallback on namespace dependencies since - -- the things we want names for are obviously outside of our scope. - let ppeWithFallback = PPED.unsuffixifiedPPE $ PPED.addFallback globalPPED currentPPED - Cli.respondNumbered $ Output.ListNamespaceDependencies ppeWithFallback path externalDependencies + pped <- Cli.projectBranchPPED pb + let ppe = PPED.unsuffixifiedPPE pped + Cli.respondNumbered $ Output.ListNamespaceDependencies ppe pp externalDependencies -- | Check the dependencies of all types and terms in the current namespace, -- returns a map of dependencies which do not have a name within the current namespace, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs index 0416672e3e..4dce00e742 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs @@ -36,7 +36,7 @@ diffHelper before after = Cli.Env {codebase} <- ask hqLength <- Cli.runTransaction Codebase.hashLength diff <- liftIO (BranchDiff.diff0 before after) - names <- Cli.currentNames + names <- Cli.currentNames <&> \currentNames -> currentNames <> Branch.toNames before <> Branch.toNames after pped <- Cli.prettyPrintEnvDeclFromNames names let suffixifiedPPE = PPED.suffixifiedPPE pped fmap (suffixifiedPPE,) do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 5d15bf659c..8a872d18b8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -5,24 +5,21 @@ module Unison.Codebase.Editor.HandleInput.ProjectClone where import Control.Lens (_2) -import Control.Monad.Reader (ask) import Data.These (These (..)) import Data.UUID.V4 qualified as UUID import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..)) import U.Codebase.Sqlite.DbId qualified as Sqlite import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..)) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli (updateAt) -import Unison.Cli.ProjectUtils (projectBranchPath) +import Unison.Cli.MonadUtils qualified as Cli (getCurrentProjectAndBranch) import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.Share.Projects qualified as Share -import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectName, projectNameUserSlug) import Unison.Sqlite qualified as Sqlite @@ -39,9 +36,9 @@ data RemoteProjectKey -- | Clone a remote branch. handleClone :: ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Cli () handleClone remoteNames0 maybeLocalNames0 = do - maybeCurrentProjectBranch <- ProjectUtils.getCurrentProjectBranch - resolvedRemoteNames <- resolveRemoteNames Share.NoSquashedHead maybeCurrentProjectBranch remoteNames0 - localNames1 <- resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames0 + currentProjectBranch <- Cli.getCurrentProjectAndBranch + resolvedRemoteNames <- resolveRemoteNames Share.NoSquashedHead currentProjectBranch remoteNames0 + localNames1 <- resolveLocalNames currentProjectBranch resolvedRemoteNames maybeLocalNames0 cloneInto localNames1 resolvedRemoteNames.branch data ResolvedRemoteNames = ResolvedRemoteNames @@ -78,63 +75,59 @@ data ResolvedRemoteNamesFrom -- otherwise abort resolveRemoteNames :: Share.IncludeSquashedHead -> - Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path) -> + (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> ProjectAndBranchNames -> Cli ResolvedRemoteNames -resolveRemoteNames includeSquashed maybeCurrentProjectBranch = \case - ProjectAndBranchNames'Ambiguous remoteProjectName remoteBranchName -> - case maybeCurrentProjectBranch of - Nothing -> resolveP remoteProjectName - Just (currentProjectAndBranch, _path) -> - case projectNameUserSlug remoteProjectName of - Nothing -> resolveB remoteBranchName - Just _ -> - Cli.runTransaction (loadAssociatedRemoteProjectId currentProjectAndBranch) >>= \case - Nothing -> resolveP remoteProjectName - Just remoteBranchProjectId -> do - -- Fetching these in parallel would be an improvement - maybeRemoteProject <- Share.getProjectByName remoteProjectName - maybeRemoteBranch <- - Share.getProjectBranchByName includeSquashed (ProjectAndBranch remoteBranchProjectId remoteBranchName) <&> \case - Share.GetProjectBranchResponseBranchNotFound -> Nothing - Share.GetProjectBranchResponseProjectNotFound -> Nothing - Share.GetProjectBranchResponseSuccess remoteBranch -> Just remoteBranch - case (maybeRemoteProject, maybeRemoteBranch) of - (Just remoteProject, Nothing) -> do - let remoteProjectId = remoteProject.projectId - let remoteProjectName = remoteProject.projectName - let remoteBranchName = unsafeFrom @Text "main" - remoteBranch <- - ProjectUtils.expectRemoteProjectBranchByName - includeSquashed - (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) - pure - ResolvedRemoteNames - { branch = remoteBranch, - from = ResolvedRemoteNamesFrom'Project - } - (Nothing, Just remoteBranch) -> - pure - ResolvedRemoteNames - { branch = remoteBranch, - from = ResolvedRemoteNamesFrom'Branch - } - -- Treat neither existing and both existing uniformly as "ambiguous input" - -- Alternatively, if neither exist, we could instead say "although your input was ambiguous, disambuating - -- wouldn't help, because we did enough work to know neither thing exists" - _ -> do - branchProjectName <- - Cli.runTransaction (Queries.expectRemoteProjectName remoteBranchProjectId Share.hardCodedUri) - Cli.returnEarly $ - Output.AmbiguousCloneRemote - remoteProjectName - (ProjectAndBranch branchProjectName remoteBranchName) +resolveRemoteNames includeSquashed currentProjectAndBranch = \case + ProjectAndBranchNames'Ambiguous remoteProjectName remoteBranchName -> do + case projectNameUserSlug remoteProjectName of + Nothing -> resolveB remoteBranchName + Just _ -> + Cli.runTransaction (loadAssociatedRemoteProjectId currentProjectAndBranch) >>= \case + Nothing -> resolveP remoteProjectName + Just remoteBranchProjectId -> do + -- Fetching these in parallel would be an improvement + maybeRemoteProject <- Share.getProjectByName remoteProjectName + maybeRemoteBranch <- + Share.getProjectBranchByName includeSquashed (ProjectAndBranch remoteBranchProjectId remoteBranchName) <&> \case + Share.GetProjectBranchResponseBranchNotFound -> Nothing + Share.GetProjectBranchResponseProjectNotFound -> Nothing + Share.GetProjectBranchResponseSuccess remoteBranch -> Just remoteBranch + case (maybeRemoteProject, maybeRemoteBranch) of + (Just remoteProject, Nothing) -> do + let remoteProjectId = remoteProject.projectId + let remoteProjectName = remoteProject.projectName + let remoteBranchName = unsafeFrom @Text "main" + remoteBranch <- + ProjectUtils.expectRemoteProjectBranchByName + includeSquashed + (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) + pure + ResolvedRemoteNames + { branch = remoteBranch, + from = ResolvedRemoteNamesFrom'Project + } + (Nothing, Just remoteBranch) -> + pure + ResolvedRemoteNames + { branch = remoteBranch, + from = ResolvedRemoteNamesFrom'Branch + } + -- Treat neither existing and both existing uniformly as "ambiguous input" + -- Alternatively, if neither exist, we could instead say "although your input was ambiguous, disambuating + -- wouldn't help, because we did enough work to know neither thing exists" + _ -> do + branchProjectName <- + Cli.runTransaction (Queries.expectRemoteProjectName remoteBranchProjectId Share.hardCodedUri) + Cli.returnEarly $ + Output.AmbiguousCloneRemote + remoteProjectName + (ProjectAndBranch branchProjectName remoteBranchName) ProjectAndBranchNames'Unambiguous (This p) -> resolveP p ProjectAndBranchNames'Unambiguous (That b) -> resolveB b ProjectAndBranchNames'Unambiguous (These p b) -> resolvePB p b where resolveB branchName = do - (currentProjectAndBranch, _path) <- maybeCurrentProjectBranch & onNothing (Cli.returnEarly Output.NotOnProjectBranch) remoteProjectId <- Cli.runTransaction (loadAssociatedRemoteProjectId currentProjectAndBranch) & onNothingM do Cli.returnEarly (Output.NoAssociatedRemoteProjectBranch Share.hardCodedUri currentProjectAndBranch) @@ -181,11 +174,11 @@ resolveRemoteNames includeSquashed maybeCurrentProjectBranch = \case -- `clone @foo/bar` resulted in treating `@foo/bar` as a contributor branch of the current project, then it is as if -- the user typed `clone /@foo/bar` instead, which is equivalent to the two-arg `clone /@foo/bar /@foo/bar`. resolveLocalNames :: - Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path) -> + (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> ResolvedRemoteNames -> Maybe ProjectAndBranchNames -> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName) -resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames = +resolveLocalNames (ProjectAndBranch currentProject _) resolvedRemoteNames maybeLocalNames = resolve case maybeLocalNames of Nothing -> ProjectAndBranchNames'Unambiguous case resolvedRemoteNames.from of @@ -199,14 +192,11 @@ resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames resolve names = case names of - ProjectAndBranchNames'Ambiguous localProjectName localBranchName -> - case maybeCurrentProjectBranch of - Nothing -> resolveP localProjectName - Just (ProjectAndBranch currentProject _, _path) -> do - Cli.returnEarly $ - Output.AmbiguousCloneLocal - (ProjectAndBranch localProjectName remoteBranchName) - (ProjectAndBranch currentProject.name localBranchName) + ProjectAndBranchNames'Ambiguous localProjectName localBranchName -> do + Cli.returnEarly $ + Output.AmbiguousCloneLocal + (ProjectAndBranch localProjectName remoteBranchName) + (ProjectAndBranch currentProject.name localBranchName) ProjectAndBranchNames'Unambiguous (This localProjectName) -> resolveP localProjectName ProjectAndBranchNames'Unambiguous (That localBranchName) -> resolveB localBranchName ProjectAndBranchNames'Unambiguous (These localProjectName localBranchName) -> resolvePB localProjectName localBranchName @@ -215,8 +205,6 @@ resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames go (LocalProjectKey'Name localProjectName) remoteBranchName resolveB localBranchName = do - (ProjectAndBranch currentProject _, _path) <- - maybeCurrentProjectBranch & onNothing (Cli.returnEarly Output.NotOnProjectBranch) go (LocalProjectKey'Project currentProject) localBranchName resolvePB localProjectName localBranchName = @@ -254,7 +242,11 @@ cloneInto localProjectBranch remoteProjectBranch = do pure (localProjectId, localProjectName) Right localProject -> pure (localProject.projectId, localProject.name) localBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) + causalHashId <- Q.expectCausalHashIdByCausalHash branchHead + let description = "Cloned from " <> into @Text (ProjectAndBranch remoteProjectName remoteBranchName) Queries.insertProjectBranch + description + causalHashId Sqlite.ProjectBranch { projectId = localProjectId, branchId = localBranchId, @@ -277,12 +269,8 @@ cloneInto localProjectBranch remoteProjectBranch = do localProjectBranch.branch ) - -- Manipulate the root namespace and cd - Cli.Env {codebase} <- ask - theBranch <- liftIO (Codebase.expectBranchForHash codebase branchHead) - let path = projectBranchPath (over #project fst localProjectAndBranch) - Cli.updateAt ("clone " <> into @Text remoteProjectBranchNames) path (const theBranch) - Cli.cd path + let newProjectAndBranch = (over #project fst localProjectAndBranch) + Cli.switchProject newProjectAndBranch -- Return the remote project id associated with the given project branch loadAssociatedRemoteProjectId :: diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 8ffe4e9777..e9f6e99e95 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -4,23 +4,23 @@ module Unison.Codebase.Editor.HandleInput.ProjectCreate ) where +import Control.Lens import Control.Monad.Reader (ask) -import Data.Map.Strict qualified as Map import Data.Text qualified as Text -import Data.UUID.V4 qualified as UUID import System.Random.Shuffle qualified as RandomShuffle import U.Codebase.Sqlite.DbId +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries (expectCausalHashIdByCausalHash) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli (stepAt) -import Unison.Cli.ProjectUtils (projectBranchPath) import Unison.Cli.Share.Projects qualified as Share import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Causal qualified as Causal import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Operations qualified as Ops import Unison.NameSegment qualified as NameSegment import Unison.Prelude @@ -55,14 +55,12 @@ import Witch (unsafeFrom) -- -- For now, it doesn't seem worth it to do (1) or (2), since we want to do (3) eventually, and we'd rather not waste too -- much time getting everything perfectly correct before we get there. -projectCreate :: Bool -> Maybe ProjectName -> Cli () +projectCreate :: Bool -> Maybe ProjectName -> Cli (ProjectAndBranch ProjectId ProjectBranchId) projectCreate tryDownloadingBase maybeProjectName = do - projectId <- liftIO (ProjectId <$> UUID.nextRandom) - branchId <- liftIO (ProjectBranchId <$> UUID.nextRandom) - let branchName = unsafeFrom @Text "main" + (_, emptyCausalHashId) <- Cli.runTransaction Codebase.emptyCausalHash - projectName <- + (project, branch) <- case maybeProjectName of Nothing -> do randomProjectNames <- liftIO generateRandomProjectNames @@ -70,23 +68,21 @@ projectCreate tryDownloadingBase maybeProjectName = do let loop = \case [] -> error (reportBug "E066388" "project name supply is supposed to be infinite") projectName : projectNames -> - Queries.projectExistsByName projectName >>= \case - False -> do - Ops.insertProjectAndBranch projectId projectName branchId branchName - pure projectName - True -> loop projectNames + Queries.loadProjectByName projectName >>= \case + Nothing -> do + (project, branch) <- Ops.insertProjectAndBranch projectName branchName emptyCausalHashId + pure (project, branch) + Just _project -> loop projectNames loop randomProjectNames Just projectName -> do Cli.runTransactionWithRollback \rollback -> do Queries.projectExistsByName projectName >>= \case False -> do - Ops.insertProjectAndBranch projectId projectName branchId branchName - pure projectName + Ops.insertProjectAndBranch projectName branchName emptyCausalHashId True -> rollback (Output.ProjectNameAlreadyExists projectName) - let path = projectBranchPath ProjectAndBranch {project = projectId, branch = branchId} - Cli.respond (Output.CreatedProject (isNothing maybeProjectName) projectName) - Cli.cd path + Cli.respond (Output.CreatedProject (isNothing maybeProjectName) project.name) + Cli.switchProject (ProjectAndBranch project.projectId branch.branchId) maybeBaseLatestReleaseBranchObject <- if tryDownloadingBase @@ -126,30 +122,29 @@ projectCreate tryDownloadingBase maybeProjectName = do pure maybeBaseLatestReleaseBranchObject else pure Nothing - let projectBranchObject = - case maybeBaseLatestReleaseBranchObject of - Nothing -> Branch.empty0 - Just baseLatestReleaseBranchObject -> - let -- lib.base - projectBranchLibBaseObject = - over - Branch.children - (Map.insert NameSegment.baseSegment baseLatestReleaseBranchObject) - Branch.empty0 - projectBranchLibObject = Branch.cons projectBranchLibBaseObject Branch.empty - in over - Branch.children - (Map.insert NameSegment.libSegment projectBranchLibObject) - Branch.empty0 - - Cli.stepAt reflogDescription (Path.unabsolute path, const projectBranchObject) + for_ maybeBaseLatestReleaseBranchObject \baseLatestReleaseBranchObject -> do + -- lib.base + let projectBranchLibBaseObject = + Branch.empty0 + & Branch.children + . at NameSegment.baseSegment + .~ Just baseLatestReleaseBranchObject + projectBranchLibObject = Branch.cons projectBranchLibBaseObject Branch.empty + let branchWithBase = + Branch.empty + & Branch.history + . Causal.head_ + . Branch.children + . at NameSegment.libSegment + .~ Just projectBranchLibObject + Cli.Env {codebase} <- ask + liftIO $ Codebase.putBranch codebase branchWithBase + Cli.runTransaction $ do + baseBranchCausalHashId <- expectCausalHashIdByCausalHash (Branch.headHash branchWithBase) + Queries.setProjectBranchHead "Include latest base library" project.projectId branch.branchId baseBranchCausalHashId Cli.respond Output.HappyCoding - where - reflogDescription = - case maybeProjectName of - Nothing -> "project.create" - Just projectName -> "project.create " <> into @Text projectName + pure ProjectAndBranch {project = project.projectId, branch = branch.branchId} -- An infinite list of random project names that looks like -- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs index f7d960d2df..117f12bb80 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs @@ -4,21 +4,22 @@ module Unison.Codebase.Editor.HandleInput.ProjectRename ) where +import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude -import Unison.Project (ProjectName) +import Unison.Project (ProjectAndBranch (..), ProjectName) handleProjectRename :: ProjectName -> Cli () handleProjectRename newName = do - project <- ProjectUtils.expectCurrentProject - let oldName = project ^. #name + ProjectAndBranch project _branch <- Cli.getCurrentProjectAndBranch + let oldName = project.name when (oldName /= newName) do Cli.runTransactionWithRollback \rollback -> do Queries.loadProjectByName newName >>= \case Just _ -> rollback (Output.ProjectNameAlreadyExists newName) - Nothing -> Queries.renameProject (project ^. #projectId) newName + Nothing -> Queries.renameProject project.projectId newName Cli.respond (Output.RenamedProject oldName newName) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs index ef668fa477..8799fa4e2f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs @@ -5,11 +5,11 @@ module Unison.Codebase.Editor.HandleInput.ProjectSwitch where import Data.These (These (..)) -import U.Codebase.Sqlite.Project qualified -import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude @@ -28,51 +28,46 @@ import Witch (unsafeFrom) projectSwitch :: ProjectAndBranchNames -> Cli () projectSwitch projectNames = do case projectNames of - ProjectAndBranchNames'Ambiguous projectName branchName -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> switchToProjectAndBranchByTheseNames (This projectName) - Just (ProjectAndBranch currentProject _currentBranch, _restPath) -> do - (projectExists, branchExists) <- - Cli.runTransaction do - (,) - <$> Queries.projectExistsByName projectName - <*> Queries.projectBranchExistsByName currentProject.projectId branchName - case (projectExists, branchExists) of - (False, False) -> Cli.respond (Output.LocalProjectNorProjectBranchExist projectName branchName) - (False, True) -> switchToProjectAndBranchByTheseNames (These currentProject.name branchName) - (True, False) -> switchToProjectAndBranchByTheseNames (This projectName) - (True, True) -> - Cli.respondNumbered $ - Output.AmbiguousSwitch - projectName - (ProjectAndBranch currentProject.name branchName) + ProjectAndBranchNames'Ambiguous projectName branchName -> do + ProjectAndBranch currentProject _currentBranch <- Cli.getCurrentProjectAndBranch + (projectExists, branchExists) <- + Cli.runTransaction do + (,) + <$> Queries.projectExistsByName projectName + <*> Queries.projectBranchExistsByName currentProject.projectId branchName + case (projectExists, branchExists) of + (False, False) -> Cli.respond (Output.LocalProjectNorProjectBranchExist projectName branchName) + (False, True) -> switchToProjectAndBranchByTheseNames (These currentProject.name branchName) + (True, False) -> switchToProjectAndBranchByTheseNames (This projectName) + (True, True) -> + Cli.respondNumbered $ + Output.AmbiguousSwitch + projectName + (ProjectAndBranch currentProject.name branchName) ProjectAndBranchNames'Unambiguous projectAndBranchNames0 -> switchToProjectAndBranchByTheseNames projectAndBranchNames0 switchToProjectAndBranchByTheseNames :: These ProjectName ProjectBranchName -> Cli () switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do - branch <- - case projectAndBranchNames0 of - This projectName -> - Cli.runTransactionWithRollback \rollback -> do - project <- - Queries.loadProjectByName projectName & onNothingM do - rollback (Output.LocalProjectDoesntExist projectName) - Queries.loadMostRecentBranch project.projectId >>= \case - Nothing -> do - let branchName = unsafeFrom @Text "main" - branch <- - Queries.loadProjectBranchByName project.projectId branchName & onNothingM do - rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) - Queries.setMostRecentBranch branch.projectId branch.branchId - pure branch - Just branchId -> Queries.expectProjectBranch project.projectId branchId - _ -> do - projectAndBranchNames <- ProjectUtils.hydrateNames projectAndBranchNames0 - Cli.runTransactionWithRollback \rollback -> do - branch <- - Queries.loadProjectBranchByNames projectAndBranchNames.project projectAndBranchNames.branch & onNothingM do - rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) - Queries.setMostRecentBranch branch.projectId branch.branchId - pure branch - Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch branch.projectId branch.branchId)) + branch <- case projectAndBranchNames0 of + This projectName -> + Cli.runTransactionWithRollback \rollback -> do + project <- + Queries.loadProjectByName projectName & onNothingM do + rollback (Output.LocalProjectDoesntExist projectName) + Queries.loadMostRecentBranch (project ^. #projectId) >>= \case + Nothing -> do + let branchName = unsafeFrom @Text "main" + branch <- + Queries.loadProjectBranchByName project.projectId branchName & onNothingM do + rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) + pure branch + Just branchId -> Queries.expectProjectBranch project.projectId branchId + _ -> do + projectAndBranchNames@(ProjectAndBranch projectName branchName) <- ProjectUtils.hydrateNames projectAndBranchNames0 + Cli.runTransactionWithRollback \rollback -> do + branch <- + Queries.loadProjectBranchByNames projectName branchName & onNothingM do + rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) + pure branch + Cli.switchProject (ProjectAndBranch (branch ^. #projectId) (branch ^. #branchId)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 6165d60bc3..3ff7012220 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -21,9 +21,9 @@ import Unison.Cli.MergeTypes (MergeSource (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.Share.Projects qualified as Share -import Unison.Cli.UnisonConfigUtils (resolveConfiguredUrl) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch (..)) import Unison.Codebase.Branch qualified as Branch @@ -34,13 +34,11 @@ import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Editor.Output.PushPull qualified as PushPull import Unison.Codebase.Editor.Propagate qualified as Propagate import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace (..), printReadRemoteNamespace) -import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Patch (Patch (..)) -import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.InputPattern qualified as InputPattern import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.NameSegment qualified as NameSegment @@ -76,8 +74,7 @@ handlePull unresolvedSourceAndTarget pullMode = do when remoteBranchIsEmpty (Cli.respond (PulledEmptyBranch source)) - let targetAbsolutePath = - ProjectUtils.projectBranchPath (ProjectAndBranch target.project.projectId target.branch.branchId) + let targetProjectPath = PP.projectBranchRoot (ProjectAndBranch target.project target.branch) let description = Text.unwords @@ -92,22 +89,18 @@ handlePull unresolvedSourceAndTarget pullMode = do case pullMode of Input.PullWithHistory -> do - targetBranchObject <- Cli.getBranch0At targetAbsolutePath + targetBranch <- Cli.getBranchFromProjectPath targetProjectPath - if Branch.isEmpty0 targetBranchObject + if Branch.isEmpty0 $ Branch.head targetBranch then do Cli.Env {codebase} <- ask remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase remoteCausalHash) - void $ Cli.updateAtM description targetAbsolutePath (const $ pure remoteBranchObject) + void $ Cli.updateAtM description targetProjectPath (const $ pure remoteBranchObject) Cli.respond $ MergeOverEmpty target else do Cli.respond AboutToMerge - aliceCausalHash <- - Cli.runTransaction do - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute targetAbsolutePath) - pure causal.causalHash - + let aliceCausalHash = Branch.headHash targetBranch lcaCausalHash <- Cli.runTransaction (Operations.lca aliceCausalHash remoteCausalHash) doMerge @@ -139,7 +132,7 @@ handlePull unresolvedSourceAndTarget pullMode = do didUpdate <- Cli.updateAtM description - targetAbsolutePath + targetProjectPath (\targetBranchObject -> pure $ remoteBranchObject `Branch.consBranchSnapshot` targetBranchObject) Cli.respond @@ -167,30 +160,29 @@ resolveSourceAndTarget includeSquashed = \case pure (source, target) resolveImplicitSource :: Share.IncludeSquashedHead -> Cli (ReadRemoteNamespace Share.RemoteProjectBranch) -resolveImplicitSource includeSquashed = - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> RemoteRepo.writeNamespaceToRead <$> resolveConfiguredUrl PushPull.Pull Path.currentPath - Just (localProjectAndBranch, _restPath) -> do - (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) <- - Cli.runTransactionWithRollback \rollback -> do - let localProjectId = localProjectAndBranch.project.projectId - let localBranchId = localProjectAndBranch.branch.branchId - Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId >>= \case - Just (remoteProjectId, Just remoteBranchId) -> do - remoteProjectName <- Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri - remoteBranchName <- - Queries.expectRemoteProjectBranchName - Share.hardCodedUri - remoteProjectId - remoteBranchId - pure (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) - _ -> rollback (Output.NoAssociatedRemoteProjectBranch Share.hardCodedUri localProjectAndBranch) - remoteBranch <- - ProjectUtils.expectRemoteProjectBranchById includeSquashed $ - ProjectAndBranch - (remoteProjectId, remoteProjectName) - (remoteBranchId, remoteBranchName) - pure (ReadShare'ProjectBranch remoteBranch) +resolveImplicitSource includeSquashed = do + pp <- Cli.getCurrentProjectPath + let localProjectAndBranch = PP.toProjectAndBranch pp + (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) <- + Cli.runTransactionWithRollback \rollback -> do + let localProjectId = localProjectAndBranch.project.projectId + let localBranchId = localProjectAndBranch.branch.branchId + Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId >>= \case + Just (remoteProjectId, Just remoteBranchId) -> do + remoteProjectName <- Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri + remoteBranchName <- + Queries.expectRemoteProjectBranchName + Share.hardCodedUri + remoteProjectId + remoteBranchId + pure (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) + _ -> rollback (Output.NoAssociatedRemoteProjectBranch Share.hardCodedUri localProjectAndBranch) + remoteBranch <- + ProjectUtils.expectRemoteProjectBranchById includeSquashed $ + ProjectAndBranch + (remoteProjectId, remoteProjectName) + (remoteBranchId, remoteBranchName) + pure (ReadShare'ProjectBranch remoteBranch) resolveExplicitSource :: Share.IncludeSquashedHead -> @@ -208,7 +200,7 @@ resolveExplicitSource includeSquashed = \case (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) pure (ReadShare'ProjectBranch remoteProjectBranch) ReadShare'ProjectBranch (That branchNameOrLatestRelease) -> do - (localProjectAndBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch + localProjectAndBranch <- PP.toProjectAndBranch <$> Cli.getCurrentProjectPath let localProjectId = localProjectAndBranch.project.projectId let localBranchId = localProjectAndBranch.branch.branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case @@ -243,8 +235,7 @@ resolveExplicitSource includeSquashed = \case resolveImplicitTarget :: Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) resolveImplicitTarget = do - (projectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch - pure projectAndBranch + PP.toProjectAndBranch <$> Cli.getCurrentProjectPath -- | supply `dest0` if you want to print diff messages -- supply unchangedMessage if you want to display it if merge had no effect @@ -253,8 +244,8 @@ mergeBranchAndPropagateDefaultPatch :: Text -> Maybe Output -> Branch IO -> - Maybe (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> - Path.Absolute -> + Maybe (Either PP.ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> + PP.ProjectPath -> Cli () mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb maybeDest0 dest = ifM @@ -266,7 +257,7 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb mergeBranch = Cli.time "mergeBranch" do Cli.Env {codebase} <- ask - destb <- Cli.getBranchAt dest + destb <- Cli.getBranchFromProjectPath dest merged <- liftIO (Branch.merge'' (Codebase.lca codebase) mode srcb destb) b <- Cli.updateAtM inputDescription dest (const $ pure merged) for_ maybeDest0 \dest0 -> do @@ -276,19 +267,19 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb loadPropagateDiffDefaultPatch :: Text -> - Maybe (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> - Path.Absolute -> + Maybe (Either PP.ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> + PP.ProjectPath -> Cli () loadPropagateDiffDefaultPatch inputDescription maybeDest0 dest = do Cli.respond Output.AboutToPropagatePatch Cli.time "loadPropagateDiffDefaultPatch" do - original <- Cli.getBranch0At dest + original <- Cli.getBranch0FromProjectPath dest patch <- liftIO $ Branch.getPatch NameSegment.defaultPatchSegment original patchDidChange <- propagatePatch inputDescription patch dest when patchDidChange do whenJust maybeDest0 \dest0 -> do Cli.respond Output.CalculatingDiff - patched <- Cli.getBranchAt dest + patched <- Cli.getBranchFromProjectPath dest let patchPath = Path.Path' (Right (Path.Relative (Path.fromList [NameSegment.defaultPatchSegment]))) (ppe, diff) <- diffHelper original (Branch.head patched) Cli.respondNumbered (ShowDiffAfterMergePropagate dest0 dest patchPath ppe diff) @@ -297,10 +288,11 @@ loadPropagateDiffDefaultPatch inputDescription maybeDest0 dest = do propagatePatch :: Text -> Patch -> - Path.Absolute -> + PP.ProjectPath -> Cli Bool propagatePatch inputDescription patch scopePath = do Cli.time "propagatePatch" do + rootNames <- Cli.projectBranchNames scopePath.branch Cli.stepAt' (inputDescription <> " (applying patch)") - (Path.unabsolute scopePath, Propagate.propagateAndApply patch) + (scopePath, Propagate.propagateAndApply rootNames patch) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index a9aba3224c..1bb63940d6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -9,13 +9,13 @@ import Control.Lens (_1, _2) import Data.Set.NonEmpty qualified as Set.NonEmpty import Data.Text as Text import Data.These (These (..)) -import Data.Void (absurd) import System.Console.Regions qualified as Console.Regions import Text.Builder qualified import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project qualified as Sqlite (Project) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) @@ -23,7 +23,6 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.Share.Projects qualified as Share -import Unison.Cli.UnisonConfigUtils qualified as UnisonConfigUtils import Unison.Codebase.Editor.HandleInput.AuthLogin qualified as AuthLogin import Unison.Codebase.Editor.Input ( PushRemoteBranchInput (..), @@ -32,13 +31,6 @@ import Unison.Codebase.Editor.Input ) import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Editor.Output.PushPull (PushPull (Push)) -import Unison.Codebase.Editor.RemoteRepo - ( WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), - ) -import Unison.Codebase.Path qualified as Path -import Unison.Codebase.PushBehavior (PushBehavior) import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName)) import Unison.Hash32 (Hash32) @@ -67,49 +59,16 @@ handlePushRemoteBranch :: PushRemoteBranchInput -> Cli () handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do case sourceTarget of -- push to - PushSourceTarget0 -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> do - localPath <- Cli.getCurrentPath - UnisonConfigUtils.resolveConfiguredUrl Push Path.currentPath >>= \case - WriteRemoteNamespaceShare namespace -> pushLooseCodeToShareLooseCode localPath namespace pushBehavior - WriteRemoteProjectBranch v -> absurd v - Just (localProjectAndBranch, _restPath) -> - pushProjectBranchToProjectBranch - force - localProjectAndBranch - Nothing + PushSourceTarget0 -> do + localProjectAndBranch <- Cli.getCurrentProjectAndBranch + pushProjectBranchToProjectBranch force localProjectAndBranch Nothing -- push to .some.path (share) - PushSourceTarget1 (WriteRemoteNamespaceShare namespace) -> do - localPath <- Cli.getCurrentPath - pushLooseCodeToShareLooseCode localPath namespace pushBehavior -- push to @some/project - PushSourceTarget1 (WriteRemoteProjectBranch remoteProjectAndBranch0) -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> do - localPath <- Cli.getCurrentPath - remoteProjectAndBranch <- ProjectUtils.hydrateNames remoteProjectAndBranch0 - pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch - Just (localProjectAndBranch, _restPath) -> - pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch0) - -- push .some.path to .some.path (share) - PushSourceTarget2 (PathySource localPath0) (WriteRemoteNamespaceShare namespace) -> do - localPath <- Cli.resolvePath' localPath0 - pushLooseCodeToShareLooseCode localPath namespace pushBehavior - -- push .some.path to @some/project - PushSourceTarget2 (PathySource localPath0) (WriteRemoteProjectBranch remoteProjectAndBranch0) -> do - localPath <- Cli.resolvePath' localPath0 - remoteProjectAndBranch <- ProjectUtils.hydrateNames remoteProjectAndBranch0 - pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch - -- push @some/project to .some.path (share) - PushSourceTarget2 (ProjySource localProjectAndBranch0) (WriteRemoteNamespaceShare namespace) -> do - ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames localProjectAndBranch0 - pushLooseCodeToShareLooseCode - (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) - namespace - pushBehavior + PushSourceTarget1 remoteProjectAndBranch0 -> do + localProjectAndBranch <- Cli.getCurrentProjectAndBranch + pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch0) -- push @some/project to @some/project - PushSourceTarget2 (ProjySource localProjectAndBranch0) (WriteRemoteProjectBranch remoteProjectAndBranch) -> do + PushSourceTarget2 (ProjySource localProjectAndBranch0) remoteProjectAndBranch -> do localProjectAndBranch <- ProjectUtils.expectProjectAndBranchByTheseNames localProjectAndBranch0 pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch) where @@ -119,24 +78,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do PushBehavior.RequireEmpty -> False PushBehavior.RequireNonEmpty -> False --- Push a local namespace ("loose code") to a Share-hosted remote namespace ("loose code"). -pushLooseCodeToShareLooseCode :: Path.Absolute -> WriteShareRemoteNamespace -> PushBehavior -> Cli () -pushLooseCodeToShareLooseCode _ _ _ = do - Cli.returnEarly LooseCodePushDeprecated - --- Push a local namespace ("loose code") to a remote project branch. -pushLooseCodeToProjectBranch :: Bool -> Path.Absolute -> ProjectAndBranch ProjectName ProjectBranchName -> Cli () -pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch = do - _ <- AuthLogin.ensureAuthenticatedWithCodeserver Codeserver.defaultCodeserver - localBranchHead <- - Cli.runTransactionWithRollback \rollback -> do - loadCausalHashToPush localPath >>= \case - Nothing -> rollback (EmptyLooseCodePush (Path.absoluteToPath' localPath)) - Just hash -> pure hash - - uploadPlan <- pushToProjectBranch0 force PushingLooseCode localBranchHead remoteProjectAndBranch - executeUploadPlan uploadPlan - -- | Push a local project branch to a remote project branch. If the remote project branch is left unspecified, we either -- use a pre-existing mapping for the local branch, or else infer what remote branch to push to (possibly creating it). pushProjectBranchToProjectBranch :: @@ -147,14 +88,11 @@ pushProjectBranchToProjectBranch :: pushProjectBranchToProjectBranch force localProjectAndBranch maybeRemoteProjectAndBranchNames = do _ <- AuthLogin.ensureAuthenticatedWithCodeserver Codeserver.defaultCodeserver let localProjectAndBranchIds = localProjectAndBranch & over #project (view #projectId) & over #branch (view #branchId) - let localProjectAndBranchNames = localProjectAndBranch & over #project (view #name) & over #branch (view #name) -- Load local project and branch from database and get the causal hash to push (localProjectAndBranch, localBranchHead) <- - Cli.runTransactionWithRollback \rollback -> do - hash <- - loadCausalHashToPush (ProjectUtils.projectBranchPath localProjectAndBranchIds) & onNothingM do - rollback (EmptyProjectBranchPush localProjectAndBranchNames) + Cli.runTransaction do + hash <- expectCausalHashToPush (localProjectAndBranch ^. #branch) localProjectAndBranch <- expectProjectAndBranch localProjectAndBranchIds pure (localProjectAndBranch, hash) @@ -471,7 +409,7 @@ executeUploadPlan UploadPlan {remoteBranch, causalHash, afterUploadAction} = do Share.TransportError err -> ShareErrorTransport err afterUploadAction let ProjectAndBranch projectName branchName = remoteBranch - Cli.respond (ViewOnShare (Right (Share.hardCodedUri, projectName, branchName))) + Cli.respond (ViewOnShare (Share.hardCodedUri, projectName, branchName)) ------------------------------------------------------------------------------------------------------------------------ -- After upload actions @@ -563,7 +501,7 @@ makeSetHeadAfterUploadAction force pushing localBranchHead remoteBranch = do when (localBranchHead == Share.API.hashJWTHash remoteBranch.branchHead) do Cli.respond (RemoteProjectBranchIsUpToDate Share.hardCodedUri remoteProjectAndBranchNames) - Cli.returnEarly (ViewOnShare (Right (Share.hardCodedUri, remoteBranch.projectName, remoteBranch.branchName))) + Cli.returnEarly (ViewOnShare (Share.hardCodedUri, remoteBranch.projectName, remoteBranch.branchName)) when (not force) do whenM (Cli.runTransaction (wouldNotBeFastForward localBranchHead remoteBranchHead)) do @@ -633,14 +571,11 @@ expectProjectAndBranch (ProjectAndBranch projectId branchId) = <$> Queries.expectProject projectId <*> Queries.expectProjectBranch projectId branchId --- Get the causal hash to push at the given path. Return Nothing if there's no history. -loadCausalHashToPush :: Path.Absolute -> Sqlite.Transaction (Maybe Hash32) -loadCausalHashToPush path = - Operations.loadCausalHashAtPath Nothing segments <&> \case - Nothing -> Nothing - Just (CausalHash hash) -> Just (Hash32.fromHash hash) - where - segments = Path.toList (Path.unabsolute path) +-- Get the causal hash for the given project branch. +expectCausalHashToPush :: ProjectBranch -> Sqlite.Transaction Hash32 +expectCausalHashToPush pb = do + CausalHash causalHash <- Operations.expectProjectBranchHead (pb ^. #projectId) (pb ^. #branchId) + pure (Hash32.fromHash causalHash) -- Were we to try to advance `remoteBranchHead` to `localBranchHead`, would it *not* be a fast-forward? wouldNotBeFastForward :: Hash32 -> Hash32 -> Sqlite.Transaction Bool diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs new file mode 100644 index 0000000000..f2006dca7e --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs @@ -0,0 +1,60 @@ +-- | Helpers for working with various kinds of reflogs. +module Unison.Codebase.Editor.HandleInput.Reflogs + ( showProjectBranchReflog, + showProjectReflog, + showGlobalReflog, + ) +where + +import Control.Monad.Reader +import Data.Time (getCurrentTime) +import U.Codebase.HashTags (CausalHash) +import U.Codebase.Sqlite.Project (Project) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.Output qualified as Output +import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Prelude +import Unison.Sqlite qualified as Sqlite + +showProjectBranchReflog :: Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> Cli () +showProjectBranchReflog mayProjectAndBranch = do + ProjectAndBranch _project branch <- case mayProjectAndBranch of + Nothing -> Cli.getCurrentProjectAndBranch + Just pab -> ProjectUtils.resolveProjectBranch (second Just pab) + reflogHelper (\n -> Codebase.getProjectBranchReflog n (branch ^. #branchId)) + +showProjectReflog :: Maybe ProjectName -> Cli () +showProjectReflog mayProject = do + ProjectAndBranch project _ <- ProjectUtils.resolveProjectBranch (ProjectAndBranch mayProject Nothing) + reflogHelper (\n -> Codebase.getProjectReflog n (project ^. #projectId)) + +showGlobalReflog :: Cli () +showGlobalReflog = do + reflogHelper Codebase.getGlobalReflog + +reflogHelper :: (Int -> Sqlite.Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash]) -> Cli () +reflogHelper getEntries = do + let numEntriesToShow = 500 + entries <- + Cli.runTransaction $ do + schLength <- Codebase.branchHashLength + entries <- getEntries numEntriesToShow + entries + & (fmap . fmap) (\ch -> (ch, SCH.fromHash schLength ch)) + & pure + let moreEntriesToLoad = + if length entries == numEntriesToShow + then Output.MoreEntriesThanShown + else Output.AllEntriesShown + mayNow <- + asks Cli.isTranscriptTest >>= \case + True -> pure Nothing + False -> Just <$> liftIO getCurrentTime + Cli.respondNumbered $ Output.ShowProjectBranchReflog mayNow moreEntriesToLoad entries diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs index 13caf9b1ac..e6cdbffc7e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs @@ -6,8 +6,8 @@ where import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..), doCreateBranch) +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..), createBranch) import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude import Unison.Project (Semver) @@ -16,15 +16,15 @@ import Witch (unsafeFrom) -- | Handle a @release.draft@ command. handleReleaseDraft :: Semver -> Cli () handleReleaseDraft ver = do - currentProjectAndBranch <- fst <$> ProjectUtils.expectCurrentProjectBranch + currentProjectAndBranch <- Cli.getCurrentProjectAndBranch let branchName = unsafeFrom @Text ("releases/drafts/" <> into @Text ver) _ <- - doCreateBranch - (CreateFrom'Branch currentProjectAndBranch) - (currentProjectAndBranch ^. #project) - branchName + createBranch ("release.draft " <> into @Text ver) + (CreateFrom'ParentBranch (currentProjectAndBranch ^. #branch)) + (currentProjectAndBranch ^. #project) + (pure branchName) Cli.respond (Output.DraftingRelease branchName ver) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs index 3eb3658004..409f7bac89 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs @@ -14,7 +14,6 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet -import Data.Tuple qualified as Tuple import Unison.ABT qualified as ABT import Unison.Builtin.Decls qualified as DD import Unison.Cli.Monad (Cli) @@ -69,29 +68,32 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = Map.fromList <$> Cli.runTransaction do Set.toList testRefs & wither \case rid -> fmap (rid,) <$> Codebase.getWatch codebase WK.TestWatch rid - let (oks, fails) = passFails cachedTests - passFails :: (Ord r) => Map r (Term v a) -> ([(r, Text)], [(r, Text)]) - passFails = Tuple.swap . partitionEithers . concat . map p . Map.toList + let (fails, oks) = passFails cachedTests + passFails :: (Ord r) => Map r (Term v a) -> (Map r [Text], Map r [Text]) + passFails = + Map.foldrWithKey + (\r v (f, o) -> bimap (\ts -> if null ts then f else Map.insert r ts f) (\ts -> if null ts then o else Map.insert r ts o) . partitionEithers $ p v) + (Map.empty, Map.empty) where - p :: (r, Term v a) -> [Either (r, Text) (r, Text)] - p (r, tm) = case tm of - Term.List' ts -> mapMaybe (q r) (toList ts) + p :: Term v a -> [Either Text Text] + p = \case + Term.List' ts -> mapMaybe q $ toList ts _ -> [] - q r = \case + q = \case Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) -> if - | ref == DD.testResultRef -> - if - | cid == DD.okConstructorId -> Just (Right (r, msg)) - | cid == DD.failConstructorId -> Just (Left (r, msg)) - | otherwise -> Nothing - | otherwise -> Nothing + | ref == DD.testResultRef -> + if + | cid == DD.okConstructorId -> Just (Right msg) + | cid == DD.failConstructorId -> Just (Left msg) + | otherwise -> Nothing + | otherwise -> Nothing _ -> Nothing let stats = Output.CachedTests (Set.size testRefs) (Map.size cachedTests) names <- Cli.currentNames pped <- Cli.prettyPrintEnvDeclFromNames names let fqnPPE = PPED.unsuffixifiedPPE pped - Cli.respond $ + Cli.respondNumbered $ TestResults stats fqnPPE @@ -123,8 +125,8 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = pure [(r, tm')] let m = Map.fromList computedTests - (mOks, mFails) = passFails m - Cli.respond $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails + (mFails, mOks) = passFails m + Cli.respondNumbered $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails handleIOTest :: HQ.HashQualified Name -> Cli () handleIOTest main = do @@ -135,11 +137,15 @@ handleIOTest main = do let isIOTest typ = Foldable.any (Typechecker.isSubtype typ) $ Runtime.ioTestTypes runtime refs <- resolveHQNames names (Set.singleton main) (fails, oks) <- - refs & foldMapM \(ref, typ) -> do - when (not $ isIOTest typ) do - Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime)) - runIOTest suffixifiedPPE ref - Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails + Foldable.foldrM + ( \(ref, typ) (f, o) -> do + when (not $ isIOTest typ) $ + Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime)) + bimap (\ts -> if null ts then f else Map.insert ref ts f) (\ts -> if null ts then o else Map.insert ref ts o) <$> runIOTest suffixifiedPPE ref + ) + (Map.empty, Map.empty) + refs + Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails findTermsOfTypes :: Codebase.Codebase m Symbol Ann -> Bool -> Path -> NESet (Type.Type Symbol Ann) -> Cli (Set TermReferenceId) findTermsOfTypes codebase includeLib path filterTypes = do @@ -163,16 +169,21 @@ handleAllIOTests = do let suffixifiedPPE = PPED.suffixifiedPPE pped ioTestRefs <- findTermsOfTypes codebase False Path.empty (Runtime.ioTestTypes runtime) case NESet.nonEmptySet ioTestRefs of - Nothing -> Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True [] [] + Nothing -> Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True Map.empty Map.empty Just neTestRefs -> do let total = NESet.size neTestRefs (fails, oks) <- - toList neTestRefs & zip [1 :: Int ..] & foldMapM \(n, r) -> do - Cli.respond $ TestIncrementalOutputStart suffixifiedPPE (n, total) r - (fails, oks) <- runIOTest suffixifiedPPE r - Cli.respond $ TestIncrementalOutputEnd suffixifiedPPE (n, total) r (null fails) - pure (fails, oks) - Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails + toList neTestRefs + & zip [1 :: Int ..] + & Foldable.foldrM + ( \(n, r) (f, o) -> do + Cli.respond $ TestIncrementalOutputStart suffixifiedPPE (n, total) r + (fails, oks) <- runIOTest suffixifiedPPE r + Cli.respond $ TestIncrementalOutputEnd suffixifiedPPE (n, total) r (null fails) + pure (if null fails then f else Map.insert r fails f, if null oks then o else Map.insert r oks o) + ) + (Map.empty, Map.empty) + Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails resolveHQNames :: Names -> Set (HQ.HashQualified Name) -> Cli (Set (Reference.Id, Type.Type Symbol Ann)) resolveHQNames parseNames hqNames = @@ -197,19 +208,16 @@ resolveHQNames parseNames hqNames = typ <- MaybeT (Codebase.getTypeOfReferent codebase (Referent.fromTermReferenceId ref)) pure (ref, typ) -runIOTest :: PPE.PrettyPrintEnv -> Reference.Id -> Cli ([(Reference.Id, Text)], [(Reference.Id, Text)]) +runIOTest :: PPE.PrettyPrintEnv -> Reference.Id -> Cli ([Text], [Text]) runIOTest ppe ref = do let a = ABT.annotation tm tm = DD.forceTerm a a (Term.refId a ref) -- Don't cache IO tests tm' <- RuntimeUtils.evalUnisonTerm False ppe False tm - pure $ partitionTestResults [(ref, tm')] + pure $ partitionTestResults tm' -partitionTestResults :: - [(Reference.Id, Term Symbol Ann)] -> - ([(Reference.Id, Text {- fails -})], [(Reference.Id, Text {- oks -})]) -partitionTestResults results = fold $ do - (ref, tm) <- results +partitionTestResults :: Term Symbol Ann -> ([Text {- fails -}], [Text {- oks -}]) +partitionTestResults tm = fold $ do element <- case tm of Term.List' ts -> toList ts _ -> empty @@ -217,9 +225,9 @@ partitionTestResults results = fold $ do Term.App' (Term.Constructor' (ConstructorReference conRef cid)) (Term.Text' msg) -> do guard (conRef == DD.testResultRef) if - | cid == DD.okConstructorId -> pure (mempty, [(ref, msg)]) - | cid == DD.failConstructorId -> pure ([(ref, msg)], mempty) - | otherwise -> empty + | cid == DD.okConstructorId -> pure (mempty, [msg]) + | cid == DD.failConstructorId -> pure ([msg], mempty) + | otherwise -> empty _ -> empty isTestOk :: Term v Ann -> Bool diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs new file mode 100644 index 0000000000..108ceee2a4 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -0,0 +1,95 @@ +-- | @todo@ input handler +module Unison.Codebase.Editor.HandleInput.Todo + ( handleTodo, + ) +where + +import Data.Either qualified as Either +import Data.Set qualified as Set +import U.Codebase.HashTags (BranchHash (..)) +import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Builtin qualified as Builtin +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Causal qualified as Causal +import Unison.Codebase.Editor.HandleInput.Merge2 (hasDefnsInLib) +import Unison.Codebase.Editor.Output +import Unison.Hash (HashFor (..)) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..), checkAllDeclCoherency) +import Unison.Names qualified as Names +import Unison.Prelude +import Unison.Reference (TermReference) +import Unison.Syntax.Name qualified as Name +import Unison.Util.Defns (Defns (..)) +import Unison.Util.Set qualified as Set + +handleTodo :: Cli () +handleTodo = do + -- For now, we don't go through any great trouble to seek out the root of the project branch. Just assume the current + -- namespace is the root, which will be the case unless the user uses `deprecated.cd`. + currentCausal <- Cli.getCurrentBranch + let currentNamespace = Branch.head currentCausal + let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace + + (defnsInLib, dependentsOfTodo, directDependencies, hashLen, incoherentDeclReasons) <- + Cli.runTransaction do + -- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand + defnsInLib <- do + branch <- + currentCausal + & Branch._history + & Causal.valueHash + & coerce @_ @BranchHash + & Operations.expectBranchByBranchHash + hasDefnsInLib branch + + let todoReference :: TermReference + todoReference = + Set.asSingleton (Names.refTermsNamed Builtin.names (Name.unsafeParseText "todo")) + & fromMaybe (error (reportBug "E260496" "No reference for builtin named 'todo'")) + + -- All type-and-term dependents of the `todo` builtin, but we know they're all terms. + dependentsOfTodo <- + Operations.directDependentsWithinScope + (Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps) + (Set.singleton todoReference) + + directDependencies <- + Operations.directDependenciesOfScope + Defns + { terms = Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps, + types = Branch.deepTypeReferenceIds currentNamespaceWithoutLibdeps + } + + hashLen <- Codebase.hashLength + + incoherentDeclReasons <- + fmap (Either.fromLeft (IncoherentDeclReasons [] [] [] [])) $ + checkAllDeclCoherency + Operations.expectDeclNumConstructors + (Names.lenientToNametree (Branch.toNames currentNamespaceWithoutLibdeps)) + + pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen, incoherentDeclReasons) + + ppe <- Cli.currentPrettyPrintEnvDecl + + Cli.respondNumbered $ + Output'Todo + TodoOutput + { defnsInLib, + dependentsOfTodo, + directDependenciesWithoutNames = + Defns + { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace), + types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace) + }, + hashLen, + incoherentDeclReasons, + nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps), + ppe + } diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs index 85ce5922f5..b80d161674 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs @@ -11,16 +11,14 @@ import U.Codebase.Reference qualified as V2 (Reference) import U.Codebase.Referent qualified as V2 (Referent) import U.Codebase.Referent qualified as V2.Referent import U.Codebase.Sqlite.Project qualified as Project -import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.ProjectUtils qualified as Project import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.ConstructorType qualified as ConstructorType import Unison.HashQualified qualified as HQ @@ -28,8 +26,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Parser.Ann (Ann (..)) import Unison.Prelude -import Unison.Project (ProjectAndBranch) -import Unison.Project.Util (projectBranchPath) +import Unison.Project (ProjectAndBranch (ProjectAndBranch)) import Unison.Referent qualified as Referent import Unison.Server.CodebaseServer qualified as Server import Unison.Sqlite qualified as Sqlite @@ -39,39 +36,27 @@ import Web.Browser (openBrowser) openUI :: Path.Path' -> Cli () openUI path' = do Cli.Env {serverBaseUrl} <- ask - currentPath <- Cli.getCurrentPath - let absPath = Path.resolve currentPath path' + defnPath <- Cli.resolvePath' path' + pp <- Cli.getCurrentProjectPath whenJust serverBaseUrl \url -> do - Project.getProjectBranchForPath absPath >>= \case - Nothing -> openUIForLooseCode url path' - Just (projectBranch, pathWithinBranch) -> openUIForProject url projectBranch pathWithinBranch + openUIForProject url pp (defnPath ^. PP.absPath_) -openUIForProject :: Server.BaseUrl -> ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Path.Path -> Cli () -openUIForProject url projectAndBranch pathFromProjectRoot = do - currentPath <- Cli.getCurrentPath - perspective <- - Project.getProjectBranchForPath currentPath <&> \case - Nothing -> - -- The current path is outside the project the argument was in. Use the project root - -- as the perspective. - Path.empty - Just (_projectBranch, pathWithinBranch) -> pathWithinBranch +openUIForProject :: Server.BaseUrl -> PP.ProjectPath -> Path.Absolute -> Cli () +openUIForProject url pp@(PP.ProjectPath project projectBranch perspective) defnPath = do mayDefinitionRef <- getDefinitionRef perspective - let projectBranchNames = bimap Project.name ProjectBranch.name projectAndBranch + let projectBranchNames = bimap Project.name ProjectBranch.name (ProjectAndBranch project projectBranch) _success <- liftIO . openBrowser . Text.unpack $ Server.urlFor (Server.ProjectBranchUI projectBranchNames perspective mayDefinitionRef) url pure () where - pathToBranchFromCodebaseRoot :: Path.Absolute - pathToBranchFromCodebaseRoot = projectBranchPath (bimap Project.projectId ProjectBranch.branchId projectAndBranch) -- If the provided ui path matches a definition, find it. - getDefinitionRef :: Path.Path -> Cli (Maybe (Server.DefinitionReference)) + getDefinitionRef :: Path.Absolute -> Cli (Maybe (Server.DefinitionReference)) getDefinitionRef perspective = runMaybeT $ do Cli.Env {codebase} <- lift ask - let absPathToDefinition = Path.unabsolute $ Path.resolve pathToBranchFromCodebaseRoot (Path.Relative pathFromProjectRoot) - (pathToDefinitionNamespace, _nameSeg) <- hoistMaybe $ Lens.unsnoc absPathToDefinition - namespaceBranch <- lift $ Cli.runTransaction (Codebase.getShallowBranchAtPath pathToDefinitionNamespace Nothing) + (pathToDefinitionNamespace, _nameSeg) <- hoistMaybe $ Lens.unsnoc defnPath + let defnNamespaceProjectPath = pp & PP.absPath_ .~ pathToDefinitionNamespace + namespaceBranch <- lift . Cli.runTransaction $ Codebase.getShallowBranchAtProjectPath defnNamespaceProjectPath fqn <- hoistMaybe $ do - pathFromPerspective <- List.stripPrefix (Path.toList perspective) (Path.toList pathFromProjectRoot) + pathFromPerspective <- List.stripPrefix (Path.toList (Path.unabsolute perspective)) (Path.toList $ Path.unabsolute defnPath) Path.toName . Path.fromList $ pathFromPerspective def <- MaybeT $ getTermOrTypeRef codebase namespaceBranch fqn pure def @@ -89,35 +74,6 @@ getTermOrTypeRef codebase namespaceBranch fqn = runMaybeT $ do pure (toTypeReference fqn oneType) terms <|> types -openUIForLooseCode :: Server.BaseUrl -> Path.Path' -> Cli () -openUIForLooseCode url path' = do - Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath - (perspective, definitionRef) <- getUIUrlParts currentPath path' codebase - _success <- liftIO . openBrowser . Text.unpack $ Server.urlFor (Server.LooseCodeUI perspective definitionRef) url - pure () - -getUIUrlParts :: Path.Absolute -> Path.Path' -> Codebase m Symbol Ann -> Cli (Path.Absolute, Maybe (Server.DefinitionReference)) -getUIUrlParts startPath definitionPath' codebase = do - let absPath = Path.resolve startPath definitionPath' - let perspective = - if Path.isAbsolute definitionPath' - then Path.absoluteEmpty - else startPath - case Lens.unsnoc absPath of - Just (abs, _nameSeg) -> do - namespaceBranch <- - Cli.runTransaction - (Codebase.getShallowBranchAtPath (Path.unabsolute abs) Nothing) - mayDefRef <- runMaybeT do - name <- hoistMaybe $ Path.toName $ Path.fromPath' definitionPath' - MaybeT $ getTermOrTypeRef codebase namespaceBranch name - case mayDefRef of - Nothing -> pure (absPath, Nothing) - Just defRef -> pure (perspective, Just defRef) - Nothing -> - pure (absPath, Nothing) - toTypeReference :: Name -> V2.Reference -> Server.DefinitionReference toTypeReference name reference = Server.TypeReference $ diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index b6bb301056..38bac30323 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -22,6 +22,7 @@ import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names as Branch import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Output @@ -35,6 +36,7 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.TermEdit qualified as TermEdit import Unison.Codebase.TypeEdit qualified as TypeEdit import Unison.DataDeclaration (Decl) @@ -73,7 +75,8 @@ import Unison.WatchKind (WatchKind) handleUpdate :: Input -> OptionalPatch -> Set Name -> Cli () handleUpdate input optionalPatch requestedNames = do Cli.Env {codebase} <- ask - currentPath' <- Cli.getCurrentPath + ppRoot <- PP.toRoot <$> Cli.getCurrentProjectPath + currentPathAbs <- Cli.getCurrentPath let patchPath = case optionalPatch of NoPatch -> Nothing @@ -165,43 +168,56 @@ handleUpdate input optionalPatch requestedNames = do p' = foldl' step1 p typeEdits step1 p (_, r, r') = Patch.updateType r (TypeEdit.Replace r') p step2 p (_, r, r') = Patch.updateTerm typing r (TermEdit.Replace r' (typing r r')) p - (p, seg) = Path.toAbsoluteSplit currentPath' patchPath + (p, seg) = Path.toAbsoluteSplit currentPathAbs patchPath updatePatches :: (Monad m) => Branch0 m -> m (Branch0 m) updatePatches = Branch.modifyPatches seg updatePatch pure (updatePatch ye'ol'Patch, updatePatches, p) - when (Slurp.hasAddsOrUpdates sr) $ do - -- take a look at the `updates` from the SlurpResult - -- and make a patch diff to record a replacement from the old to new references - Cli.stepManyAtMNoSync - ( [ ( Path.unabsolute currentPath', - pure . doSlurpUpdates typeEdits termEdits termDeprecations - ), - ( Path.unabsolute currentPath', - pure . doSlurpAdds addsAndUpdates (Slurp.originalFile sr) - ) - ] - ++ case patchOps of - Nothing -> [] - Just (_, update, p) -> [(Path.unabsolute p, update)] - ) - Cli.runTransaction - . Codebase.addDefsToCodebase codebase - . Slurp.filterUnisonFile sr - $ Slurp.originalFile sr - let codebaseAndFileNames = UF.addNamesFromTypeCheckedUnisonFile (Slurp.originalFile sr) currentCodebaseNames + updatedProjectRootBranch <- + if Slurp.hasAddsOrUpdates sr + then do + -- First add the new definitions to the codebase + Cli.runTransaction + . Codebase.addDefsToCodebase codebase + . Slurp.filterUnisonFile sr + $ Slurp.originalFile sr + projectRootBranch <- Cli.getCurrentProjectRoot + -- take a look at the `updates` from the SlurpResult + -- and make a patch diff to record a replacement from the old to new references + projectRootBranch + & Branch.stepManyAtM + ( [ ( Path.unabsolute currentPathAbs, + pure . doSlurpUpdates typeEdits termEdits termDeprecations + ), + ( Path.unabsolute currentPathAbs, + pure . doSlurpAdds addsAndUpdates (Slurp.originalFile sr) + ) + ] + ++ case patchOps of + Nothing -> [] + Just (_, update, p) -> [(Path.unabsolute p, update)] + ) + & liftIO + else Cli.getCurrentProjectRoot + + projectRootBranchWithPropagatedPatch <- case patchOps of + Nothing -> pure updatedProjectRootBranch + Just (updatedPatch, _, _) -> do + -- Propagate the patch to the whole project. + let scopePath = Path.empty + propagatePatch updatedPatch scopePath updatedProjectRootBranch + let description = case patchPath of + Nothing -> "update.nopatch" + Just p -> + p + & Path.unsplit' + & Path.resolve @_ @_ @Path.Absolute currentPathAbs + & tShow + void $ Cli.updateAt description ppRoot (const projectRootBranchWithPropagatedPatch) + let codebaseAndFileNames = UF.addNamesFromTypeCheckedUnisonFile (Slurp.originalFile sr) (Branch.toNames $ Branch.head projectRootBranchWithPropagatedPatch) pped <- Cli.prettyPrintEnvDeclFromNames codebaseAndFileNames let suffixifiedPPE = PPE.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr - whenJust patchOps \(updatedPatch, _, _) -> - void $ propagatePatchNoSync updatedPatch currentPath' - Cli.syncRoot case patchPath of - Nothing -> "update.nopatch" - Just p -> - p - & Path.unsplit' - & Path.resolve @_ @_ @Path.Absolute currentPath' - & tShow getSlurpResultForUpdate :: Set Name -> Names -> Cli SlurpResult getSlurpResultForUpdate requestedNames slurpCheckNames = do @@ -646,10 +662,11 @@ doSlurpUpdates typeEdits termEdits deprecated b0 = split = Path.splitFromName n -- Returns True if the operation changed the namespace, False otherwise. -propagatePatchNoSync :: Patch -> Path.Absolute -> Cli Bool -propagatePatchNoSync patch scopePath = +propagatePatch :: Patch -> Path.Path -> Branch.Branch IO -> Cli (Branch.Branch IO) +propagatePatch patch scopePath b = do Cli.time "propagatePatchNoSync" do - Cli.stepAtNoSync' (Path.unabsolute scopePath, Propagate.propagateAndApply patch) + let names = Branch.toNames $ Branch.head b + Branch.stepManyAtM [(scopePath, Propagate.propagateAndApply names patch)] b recomponentize :: [(Reference.Id, a)] -> [(Hash, [a])] recomponentize = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 1fb4e5eda4..007103597a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -1,3 +1,4 @@ +-- | @update@ input handler. module Unison.Codebase.Editor.HandleInput.Update2 ( handleUpdate2, @@ -49,6 +50,7 @@ import Unison.Codebase.Editor.Output (Output) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.Type (Codebase) import Unison.ConstructorReference (GConstructorReference (ConstructorReference)) import Unison.DataDeclaration (DataDeclaration, Decl) @@ -106,8 +108,8 @@ handleUpdate2 = do Cli.Env {codebase, writeSource} <- ask tuf <- Cli.expectLatestTypecheckedFile let termAndDeclNames = getTermAndDeclNames tuf - currentPath <- Cli.getCurrentPath - currentBranch0 <- Cli.getBranch0At currentPath + pp <- Cli.getCurrentProjectPath + currentBranch0 <- Cli.getCurrentBranch0 let namesIncludingLibdeps = Branch.toNames currentBranch0 let namesExcludingLibdeps = Branch.toNames (currentBranch0 & over Branch.children (Map.delete NameSegment.libSegment)) let ctorNames = forwardCtorNames namesExcludingLibdeps @@ -141,7 +143,7 @@ handleUpdate2 = do then pure tuf else do Cli.respond Output.UpdateStartTypechecking - parsingEnv <- makeParsingEnv currentPath namesIncludingLibdeps + parsingEnv <- makeParsingEnv pp namesIncludingLibdeps secondTuf <- prettyParseTypecheck bigUf pped parsingEnv & onLeftM \prettyUf -> do scratchFilePath <- fst <$> Cli.expectLatestFile @@ -185,7 +187,7 @@ prettyParseTypecheck2 prettyUf parsingEnv = do Result.Result _notes Nothing -> Left prettyUf -- @makeParsingEnv path names@ makes a parsing environment with @names@ in scope, which are all relative to @path@. -makeParsingEnv :: Path.Absolute -> Names -> Cli (Parser.ParsingEnv Transaction) +makeParsingEnv :: ProjectPath -> Names -> Cli (Parser.ParsingEnv Transaction) makeParsingEnv path names = do Cli.Env {generateUniqueName} <- ask uniqueName <- liftIO generateUniqueName @@ -200,12 +202,12 @@ makeParsingEnv path names = do saveTuf :: (Name -> Either Output (Maybe [Name])) -> TypecheckedUnisonFile Symbol Ann -> Cli () saveTuf getConstructors tuf = do Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath + pp <- Cli.getCurrentProjectPath branchUpdates <- Cli.runTransactionWithRollback \abort -> do Codebase.addDefsToCodebase codebase tuf typecheckedUnisonFileToBranchUpdates abort getConstructors tuf - Cli.stepAt "update" (Path.unabsolute currentPath, Branch.batchUpdates branchUpdates) + Cli.stepAt "update" (pp, Branch.batchUpdates branchUpdates) -- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing -- along to `batchUpdates` or some "step at" combinator) that corresponds to using all of the contents of @file@. @@ -511,17 +513,8 @@ getNamespaceDependentsOf :: Set Reference -> Transaction (DefnsF (Relation Name) TermReferenceId TypeReferenceId) getNamespaceDependentsOf names dependencies = do - dependents <- Ops.dependentsWithinScope (Names.referenceIds names) dependencies - let dependents1 :: DefnsF Set TermReferenceId TypeReferenceId - dependents1 = - Map.foldlWithKey' - ( \defns refId -> \case - Reference.RtTerm -> let !terms1 = Set.insert refId defns.terms in defns & #terms .~ terms1 - Reference.RtType -> let !types1 = Set.insert refId defns.types in defns & #types .~ types1 - ) - (Defns Set.empty Set.empty) - dependents - pure (bimap (foldMap nameTerm) (foldMap nameType) dependents1) + dependents <- Ops.transitiveDependentsWithinScope (Names.referenceIds names) dependencies + pure (bimap (foldMap nameTerm) (foldMap nameType) dependents) where nameTerm :: TermReferenceId -> Relation Name TermReferenceId nameTerm ref = @@ -542,26 +535,21 @@ getNamespaceDependentsOf2 defns dependencies = do let scope = bifoldMap toTermScope toTypeScope defns dependents <- - Ops.dependentsWithinScope scope dependencies - - let (termDependentRefs, typeDependentRefs) = - dependents & Map.partition \case - Reference.RtTerm -> True - Reference.RtType -> False + Ops.transitiveDependentsWithinScope scope dependencies pure Defns - { terms = Map.foldlWithKey' addTerms Map.empty termDependentRefs, - types = Map.foldlWithKey' addTypes Map.empty typeDependentRefs + { terms = Set.foldl' addTerms Map.empty dependents.terms, + types = Set.foldl' addTypes Map.empty dependents.types } where - addTerms :: Map Name TermReferenceId -> TermReferenceId -> ignored -> Map Name TermReferenceId - addTerms acc0 ref _ = + addTerms :: Map Name TermReferenceId -> TermReferenceId -> Map Name TermReferenceId + addTerms acc0 ref = let names = BiMultimap.lookupDom (Referent.fromTermReferenceId ref) defns.terms in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names - addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> ignored -> Map Name TypeReferenceId - addTypes acc0 ref _ = + addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> Map Name TypeReferenceId + addTypes acc0 ref = let names = BiMultimap.lookupDom (Reference.fromId ref) defns.types in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 7785e386d4..af57ea6fab 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -1,3 +1,4 @@ +-- | @upgrade@ input handler. module Unison.Codebase.Editor.HandleInput.Upgrade ( handleUpgrade, ) @@ -11,8 +12,6 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Text.Builder qualified import U.Codebase.Sqlite.DbId (ProjectId) -import U.Codebase.Sqlite.Project qualified -import U.Codebase.Sqlite.ProjectBranch qualified import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -20,6 +19,7 @@ import Unison.Cli.ProjectUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..)) import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch import Unison.Codebase.Editor.HandleInput.Update2 ( addDefinitionsToUnisonFile, @@ -34,7 +34,8 @@ import Unison.Codebase.Editor.HandleInput.Update2 ) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.Codebase.ProjectPath qualified as PP +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -46,7 +47,7 @@ import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED (addFallback) -import Unison.Project (ProjectAndBranch (..), ProjectBranchName) +import Unison.Project (ProjectBranchName) import Unison.Reference (TermReference, TypeReference) import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -66,21 +67,19 @@ handleUpgrade oldName newName = do Cli.Env {codebase, writeSource} <- ask - (projectAndBranch, _path) <- Cli.expectCurrentProjectBranch - let projectId = projectAndBranch.project.projectId - let projectPath = Cli.projectBranchPath (ProjectAndBranch projectId projectAndBranch.branch.branchId) - let oldPath = Path.resolve projectPath (Path.Relative (Path.fromList [NameSegment.libSegment, oldName])) - let newPath = Path.resolve projectPath (Path.Relative (Path.fromList [NameSegment.libSegment, newName])) + let oldPath = Path.Absolute (Path.fromList [NameSegment.libSegment, oldName]) + let newPath = Path.Absolute (Path.fromList [NameSegment.libSegment, newName]) - currentNamespace <- Cli.getBranch0At projectPath - let currentNamespaceSansOld = Branch.deleteLibdep oldName currentNamespace - let currentDeepTermsSansOld = Branch.deepTerms currentNamespaceSansOld - let currentDeepTypesSansOld = Branch.deepTypes currentNamespaceSansOld - let currentLocalNames = Branch.toNames (Branch.deleteLibdeps currentNamespace) + currentNamespace <- Cli.getCurrentProjectRoot + let currentNamespaceSansOld = currentNamespace & Branch.step (Branch.deleteLibdep oldName) + let currentNamespaceSansOld0 = Branch.head currentNamespaceSansOld + let currentDeepTermsSansOld = Branch.deepTerms currentNamespaceSansOld0 + let currentDeepTypesSansOld = Branch.deepTypes currentNamespaceSansOld0 + let currentLocalNames = Branch.toNames (Branch.deleteLibdeps $ Branch.head currentNamespace) let currentLocalConstructorNames = forwardCtorNames currentLocalNames - let currentDeepNamesSansOld = Branch.toNames currentNamespaceSansOld + let currentDeepNamesSansOld = Branch.toNames currentNamespaceSansOld0 - oldNamespace <- Cli.expectBranch0AtPath' oldPath + oldNamespace <- Cli.expectBranch0AtPath' (Path.AbsolutePath' oldPath) let oldLocalNamespace = Branch.deleteLibdeps oldNamespace let oldLocalTerms = Branch.deepTerms oldLocalNamespace let oldLocalTypes = Branch.deepTypes oldLocalNamespace @@ -88,7 +87,7 @@ handleUpgrade oldName newName = do let oldDeepMinusLocalTerms = Branch.deepTerms oldNamespaceMinusLocal let oldDeepMinusLocalTypes = Branch.deepTypes oldNamespaceMinusLocal - newNamespace <- Cli.expectBranch0AtPath' newPath + newNamespace <- Cli.expectBranch0AtPath' (Path.AbsolutePath' newPath) let newLocalNamespace = Branch.deleteLibdeps newNamespace let newLocalTerms = Branch.deepTerms newLocalNamespace let newLocalTypes = Branch.deepTypes newLocalNamespace @@ -152,27 +151,24 @@ handleUpgrade oldName newName = do `PPED.addFallback` makeComplicatedPPE hashLength currentDeepNamesSansOld mempty dependents ) - parsingEnv <- makeParsingEnv projectPath currentDeepNamesSansOld + pp@(PP.ProjectPath project projectBranch _path) <- Cli.getCurrentProjectPath + parsingEnv <- makeParsingEnv pp currentDeepNamesSansOld typecheckedUnisonFile <- prettyParseTypecheck unisonFile printPPE parsingEnv & onLeftM \prettyUnisonFile -> do - -- Small race condition: since picking a branch name and creating the branch happen in different - -- transactions, creating could fail. - temporaryBranchName <- Cli.runTransaction (findTemporaryBranchName projectId oldName newName) - temporaryBranchId <- - HandleInput.Branch.doCreateBranch - (HandleInput.Branch.CreateFrom'Branch projectAndBranch) - projectAndBranch.project - temporaryBranchName + let getTemporaryBranchName = findTemporaryBranchName (project ^. #projectId) oldName newName + (_temporaryBranchId, temporaryBranchName) <- + HandleInput.Branch.createBranch textualDescriptionOfUpgrade - let temporaryBranchPath = Path.unabsolute (Cli.projectBranchPath (ProjectAndBranch projectId temporaryBranchId)) - Cli.stepAt textualDescriptionOfUpgrade (temporaryBranchPath, \_ -> currentNamespaceSansOld) + (CreateFrom'NamespaceWithParent projectBranch currentNamespaceSansOld) + project + getTemporaryBranchName scratchFilePath <- Cli.getLatestFile <&> \case Nothing -> "scratch.u" Just (file, _) -> file liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) Cli.returnEarly $ - Output.UpgradeFailure projectAndBranch.branch.name temporaryBranchName scratchFilePath oldName newName + Output.UpgradeFailure (projectBranch ^. #name) temporaryBranchName scratchFilePath oldName newName branchUpdates <- Cli.runTransactionWithRollback \abort -> do @@ -183,7 +179,7 @@ handleUpgrade oldName newName = do typecheckedUnisonFile Cli.stepAt textualDescriptionOfUpgrade - ( Path.unabsolute projectPath, + ( PP.toRoot pp, Branch.deleteLibdep oldName . Branch.batchUpdates branchUpdates ) Cli.respond (Output.UpgradeSuccess oldName newName) diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index efcc2be7e6..d0bc3ae9d2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -9,9 +9,11 @@ module Unison.Codebase.Editor.Input Event (..), OutputLocation (..), PatchPath, + BranchIdG (..), BranchId, + BranchId2, AbsBranchId, - LooseCodeOrProject, + UnresolvedProjectBranch, parseBranchId, parseBranchId2, parseShortCausalHash, @@ -31,10 +33,11 @@ import Data.List.NonEmpty (NonEmpty) import Data.Text qualified as Text import Data.These (These) import Unison.Codebase.Branch.Merge qualified as Branch -import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteRemoteNamespace) +import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace) import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.PushBehavior (PushBehavior) import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -60,15 +63,26 @@ type PatchPath = Path.Split' data OptionalPatch = NoPatch | DefaultPatch | UsePatch PatchPath deriving (Eq, Ord, Show) -type BranchId = Either ShortCausalHash Path' +data BranchIdG p + = BranchAtSCH ShortCausalHash + | BranchAtPath p + | BranchAtProjectPath ProjectPath + deriving stock (Eq, Show, Functor, Foldable, Traversable) --- | A lot of commands can take either a loose code path or a project branch in the same argument slot. Usually, those --- have distinct syntaxes, but sometimes it's ambiguous, in which case we'd parse a `These`. The command itself can --- decide what to do with the ambiguity. -type LooseCodeOrProject = - These Path' (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) +instance (From p Text) => From (BranchIdG p) Text where + from = \case + BranchAtSCH h -> "#" <> SCH.toText h + BranchAtPath p -> from p + BranchAtProjectPath pp -> from pp -type AbsBranchId = Either ShortCausalHash Path.Absolute +type BranchId = BranchIdG Path' + +type BranchId2 = Either ShortCausalHash BranchRelativePath + +type AbsBranchId = BranchIdG Path.Absolute + +-- | An unambiguous project branch name, use the current project name if not provided. +type UnresolvedProjectBranch = ProjectAndBranch (Maybe ProjectName) ProjectBranchName type HashOrHQSplit' = Either ShortHash Path.HQSplit' @@ -79,8 +93,8 @@ data Insistence = Force | Try parseBranchId :: String -> Either Text BranchId parseBranchId ('#' : s) = case SCH.fromText (Text.pack s) of Nothing -> Left "Invalid hash, expected a base32hex string." - Just h -> pure $ Left h -parseBranchId s = Right <$> Path.parsePath' s + Just h -> pure $ BranchAtSCH h +parseBranchId s = BranchAtPath <$> Path.parsePath' s parseBranchId2 :: String -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) parseBranchId2 ('#' : s) = case SCH.fromText (Text.pack s) of @@ -106,21 +120,15 @@ data Input -- clone w/o merge, error if would clobber ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath | -- merge first causal into destination - MergeLocalBranchI LooseCodeOrProject LooseCodeOrProject Branch.MergeMode - | PreviewMergeLocalBranchI LooseCodeOrProject LooseCodeOrProject - | DiffNamespaceI BranchId BranchId -- old new + MergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) Branch.MergeMode + | PreviewMergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) + | DiffNamespaceI BranchId2 BranchId2 -- old new | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput - | ResetRootI (Either ShortCausalHash Path') - | ResetI - ( These - (Either ShortCausalHash Path') - (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - ) - (Maybe LooseCodeOrProject) - | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - -- Does it make sense to fork from not-the-root of a Github repo? - -- used in Welcome module to give directions to user + | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) + -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? + -- Does it make sense to fork from not-the-root of a Github repo? + | -- used in Welcome module to give directions to user CreateMessage (P.Pretty P.ColorText) | -- Change directory. SwitchBranchI Path' @@ -132,8 +140,8 @@ data Input -- > names .foo.bar#asdflkjsdf -- > names #sdflkjsdfhsdf NamesI IsGlobal (HQ.HashQualified Name) - | AliasTermI HashOrHQSplit' Path.Split' - | AliasTypeI HashOrHQSplit' Path.Split' + | AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force? + | AliasTypeI !Bool HashOrHQSplit' Path.Split' -- bool = force? | AliasManyI [Path.HQSplit] Path' | MoveAllI Path.Path' Path.Path' | -- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name. @@ -150,7 +158,7 @@ data Input | UpdateI OptionalPatch (Set Name) | Update2I | PreviewUpdateI (Set Name) - | TodoI (Maybe PatchPath) Path' + | TodoI | UndoI | -- First `Maybe Int` is cap on number of results, if any -- Second `Maybe Int` is cap on diff elements shown, if any @@ -182,7 +190,10 @@ data Input | StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery | -- Show provided definitions. ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name)) - | ShowReflogI + | ShowRootReflogI {- Deprecated -} + | ShowGlobalReflogI + | ShowProjectReflogI (Maybe ProjectName) + | ShowProjectBranchReflogI (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) | UpdateBuiltinsI | MergeBuiltinsI (Maybe Path) | MergeIOBuiltinsI (Maybe Path) @@ -192,6 +203,7 @@ data Input -- no path is provided. NamespaceDependenciesI (Maybe Path') | DebugTabCompletionI [String] -- The raw arguments provided + | DebugLSPNameCompletionI Text -- The raw arguments provided | DebugFuzzyOptionsI String [String] -- cmd and arguments | DebugFormatI | DebugNumberedArgsI @@ -208,7 +220,7 @@ data Input | ApiI | UiI Path' | DocToMarkdownI Name - | DocsToHtmlI Path' FilePath + | DocsToHtmlI BranchRelativePath FilePath | AuthLoginI | VersionI | ProjectCreateI Bool {- try downloading base? -} (Maybe ProjectName) @@ -229,6 +241,7 @@ data Input !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) | UpgradeCommitI | MergeCommitI + | DebugSynhashTermI !Name deriving (Eq, Show) -- | The source of a `branch` command: what to make the new branch from. @@ -237,8 +250,8 @@ data BranchSourceI BranchSourceI'CurrentContext | -- | Create an empty branch BranchSourceI'Empty - | -- | Create a branch from this loose-code-or-project - BranchSourceI'LooseCodeOrProject LooseCodeOrProject + | -- | Create a branch from this other branch + BranchSourceI'UnresolvedProjectBranch UnresolvedProjectBranch deriving stock (Eq, Show) -- | Pull source and target: either neither is specified, or only a source, or both. @@ -249,15 +262,14 @@ data PullSourceTarget deriving stock (Eq, Show) data PushSource - = PathySource Path' - | ProjySource (These ProjectName ProjectBranchName) + = ProjySource (These ProjectName ProjectBranchName) deriving stock (Eq, Show) -- | Push source and target: either neither is specified, or only a target, or both. data PushSourceTarget = PushSourceTarget0 - | PushSourceTarget1 (WriteRemoteNamespace (These ProjectName ProjectBranchName)) - | PushSourceTarget2 PushSource (WriteRemoteNamespace (These ProjectName ProjectBranchName)) + | PushSourceTarget1 (These ProjectName ProjectBranchName) + | PushSourceTarget2 PushSource (These ProjectName ProjectBranchName) deriving stock (Eq, Show) data PushRemoteBranchInput = PushRemoteBranchInput diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 6e16b4d1a9..6ae0b23616 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -8,6 +8,9 @@ module Unison.Codebase.Editor.Output ListDetailed, HistoryTail (..), TestReportStats (..), + TodoOutput (..), + todoOutputIsEmpty, + MoreEntriesThanShown (..), UndoFailureReason (..), ShareError (..), UpdateOrUpgrade (..), @@ -17,6 +20,7 @@ module Unison.Codebase.Editor.Output where import Data.List.NonEmpty (NonEmpty) +import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Time (UTCTime) import Network.URI (URI) @@ -26,6 +30,7 @@ import U.Codebase.Branch.Diff (NameChanges) import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import Unison.Auth.Types (CredentialFailure) import Unison.Cli.MergeTypes (MergeSourceAndTarget, MergeSourceOrTarget) import Unison.Cli.Share.Projects.Types qualified as Share @@ -37,35 +42,39 @@ import Unison.Codebase.Editor.RemoteRepo import Unison.Codebase.Editor.SlurpResult (SlurpResult (..)) import Unison.Codebase.Editor.SlurpResult qualified as SR import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) -import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck (IntegrityResult (..)) import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path -import Unison.Codebase.PushBehavior (PushBehavior) +import Unison.Codebase.ProjectPath (Project, ProjectBranch, ProjectPath) import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.CommandLine.BranchRelativePath (BranchRelativePath) import Unison.CommandLine.InputPattern qualified as Input import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.ConstructorId (ConstructorId) +import Unison.Hash (Hash) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..)) import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) import Unison.PrettyPrintEnvDecl qualified as PPE import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName, Semver) -import Unison.Reference (Reference, TermReferenceId, TypeReference) +import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Server.Backend (ShallowListEntry (..)) -import Unison.Server.SearchResult' (SearchResult') +import Unison.Server.SearchResultPrime (SearchResult') import Unison.Share.Sync.Types qualified as Sync import Unison.ShortHash (ShortHash) import Unison.Symbol (Symbol) @@ -75,6 +84,7 @@ import Unison.Term (Term) import Unison.Type (Type) import Unison.Typechecker.Context qualified as Context import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (DefnsF, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK @@ -93,32 +103,38 @@ type NumberedArgs = [StructuredArgument] type HashLength = Int data NumberedOutput - = ShowDiffNamespace AbsBranchId AbsBranchId PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) + = ShowDiffNamespace (Either ShortCausalHash ProjectPath) (Either ShortCausalHash ProjectPath) PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterUndo PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterDeleteDefinitions PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterDeleteBranch Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterModifyBranch Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterMerge - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - Path.Absolute + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + ProjectPath PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterMergePropagate - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - Path.Absolute + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + ProjectPath Path.Path' PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterMergePreview - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - Path.Absolute + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + ProjectPath PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterPull Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | -- ShowDiffAfterCreateAuthor NameSegment Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) - | -- | Invariant: there's at least one conflict or edit in the TodoOutput. - TodoOutput PPE.PrettyPrintEnvDecl (TO.TodoOutput Symbol Ann) + | TestResults + TestReportStats + PPE.PrettyPrintEnv + ShowSuccesses + ShowFailures + (Map TermReferenceId [Text]) -- oks + (Map TermReferenceId [Text]) -- fails + | Output'Todo !TodoOutput | -- | CantDeleteDefinitions ppe couldntDelete becauseTheseStillReferenceThem CantDeleteDefinitions PPE.PrettyPrintEnvDecl (Map LabeledDependency (NESet LabeledDependency)) | -- | CantDeleteNamespace ppe couldntDelete becauseTheseStillReferenceThem @@ -138,8 +154,30 @@ data NumberedOutput | -- | List all direct dependencies which don't have any names in the current branch ListNamespaceDependencies PPE.PrettyPrintEnv -- PPE containing names for everything from the root namespace. - Path.Absolute -- The namespace we're checking dependencies for. + ProjectPath -- The namespace we're checking dependencies for. (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents. + | ShowProjectBranchReflog + (Maybe UTCTime {- current time, omitted in transcript tests to be more deterministic -}) + MoreEntriesThanShown + [ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash)] + +data TodoOutput = TodoOutput + { defnsInLib :: !Bool, + dependentsOfTodo :: !(Set TermReferenceId), + directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference), + hashLen :: !Int, + incoherentDeclReasons :: !IncoherentDeclReasons, + nameConflicts :: !Names, + ppe :: !PrettyPrintEnvDecl + } + +todoOutputIsEmpty :: TodoOutput -> Bool +todoOutputIsEmpty todo = + Set.null todo.dependentsOfTodo + && defnsAreEmpty todo.directDependenciesWithoutNames + && Names.isEmpty todo.nameConflicts + && not todo.defnsInLib + && todo.incoherentDeclReasons == IncoherentDeclReasons [] [] [] [] data AmbiguousReset'Argument = AmbiguousReset'Hash @@ -161,15 +199,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction + -- | what we were trying to do (e.g. "run", "io.test") Text - -- ^ what we were trying to do (e.g. "run", "io.test") + -- | name of function (HQ.HashQualified Name) - -- ^ name of function + -- | bad type of function (Type Symbol Ann) - -- ^ bad type of function PPE.PrettyPrintEnv + -- | acceptable type(s) of function [Type Symbol Ann] - -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -206,12 +244,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed + -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type + -- | Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] - -- ^ Misses (search terms that returned no hits for terms or types) + -- | Hits for types if we are searching for terms or terms if we are searching for types [HQ.HashQualified Name] - -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -254,20 +292,13 @@ data Output | LoadedDefinitionsToSourceFile FilePath Int | TestIncrementalOutputStart PPE.PrettyPrintEnv (Int, Int) TermReferenceId | TestIncrementalOutputEnd PPE.PrettyPrintEnv (Int, Int) TermReferenceId Bool {- True if success, False for Failure -} - | TestResults - TestReportStats - PPE.PrettyPrintEnv - ShowSuccesses - ShowFailures - [(TermReferenceId, Text)] -- oks - [(TermReferenceId, Text)] -- fails | CantUndo UndoFailureReason | -- new/unrepresented references followed by old/removed -- todo: eventually replace these sets with [SearchResult' v Ann] -- and a nicer render. BustedBuiltins (Set Reference) (Set Reference) | ShareError ShareError - | ViewOnShare (Either WriteShareRemoteNamespace (URI, ProjectName, ProjectBranchName)) + | ViewOnShare (URI, ProjectName, ProjectBranchName) | NoConfiguredRemoteMapping PushPull Path.Absolute | ConfiguredRemoteMappingParseError PushPull Path.Absolute Text String | TermMissingType Reference @@ -285,16 +316,10 @@ data Output | AboutToMerge | -- | Indicates a trivial merge where the destination was empty and was just replaced. MergeOverEmpty (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) - | MergeAlreadyUpToDate - (Either Path' (ProjectAndBranch ProjectName ProjectBranchName)) - (Either Path' (ProjectAndBranch ProjectName ProjectBranchName)) + | MergeAlreadyUpToDate BranchRelativePath BranchRelativePath | -- This will replace the above once `merge.old` is deleted MergeAlreadyUpToDate2 !MergeSourceAndTarget - | PreviewMergeAlreadyUpToDate - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - | -- | No conflicts or edits remain for the current patch. - NoConflictsOrEdits + | PreviewMergeAlreadyUpToDate ProjectPath ProjectPath | NotImplemented | NoBranchWithHash ShortCausalHash | ListDependencies PPE.PrettyPrintEnv (Set LabeledDependency) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms @@ -306,10 +331,8 @@ data Output | BadName Text | CouldntLoadBranch CausalHash | HelpMessage Input.InputPattern - | NamespaceEmpty (NonEmpty AbsBranchId) + | NamespaceEmpty (NonEmpty (Either ShortCausalHash ProjectPath)) | NoOp - | -- Refused to push, either because a `push` targeted an empty namespace, or a `push.create` targeted a non-empty namespace. - RefusedToPush PushBehavior (WriteRemoteNamespace Void) | -- | @GistCreated repo@ means a causal was just published to @repo@. GistCreated (ReadRemoteNamespace Void) | -- | Directs the user to URI to begin an authorization flow. @@ -320,6 +343,7 @@ data Output | IntegrityCheck IntegrityResult | DisplayDebugNameDiff NameChanges | DisplayDebugCompletions [Completion.Completion] + | DisplayDebugLSPNameCompletions [(Text, Name, LabeledDependency)] | DebugDisplayFuzzyOptions Text [String {- arg description, options -}] | DebugFuzzyOptionsNoResolver | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann)) @@ -368,8 +392,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal + -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) - -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) @@ -391,7 +415,6 @@ data Output | UpdateIncompleteConstructorSet UpdateOrUpgrade Name (Map ConstructorId Name) (Maybe Int) | UpgradeFailure !ProjectBranchName !ProjectBranchName !FilePath !NameSegment !NameSegment | UpgradeSuccess !NameSegment !NameSegment - | LooseCodePushDeprecated | MergeFailure !FilePath !MergeSourceAndTarget !ProjectBranchName | MergeSuccess !MergeSourceAndTarget | MergeSuccessFastForward !MergeSourceAndTarget @@ -409,6 +432,10 @@ data Output | UseLibInstallNotPull !(ProjectAndBranch ProjectName ProjectBranchName) | PullIntoMissingBranch !(ReadRemoteNamespace Share.RemoteProjectBranch) !(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | NoMergeInProgress + | Output'DebugSynhashTerm !TermReference !Hash !Text + +data MoreEntriesThanShown = MoreEntriesThanShown | AllEntriesShown + deriving (Eq, Show) data UpdateOrUpgrade = UOUUpdate | UOUUpgrade @@ -427,12 +454,10 @@ data CreatedProjectBranchFrom -- | A branch was empty. But how do we refer to that branch? data WhichBranchEmpty = WhichBranchEmptyHash ShortCausalHash - | WhichBranchEmptyPath Path' + | WhichBranchEmptyPath ProjectPath data ShareError - = ShareErrorCheckAndSetPush Sync.CheckAndSetPushError - | ShareErrorDownloadEntities Share.DownloadEntitiesError - | ShareErrorFastForwardPush Sync.FastForwardPushError + = ShareErrorDownloadEntities Share.DownloadEntitiesError | ShareErrorGetCausalHashByPath Sync.GetCausalHashByPathError | ShareErrorPull Sync.PullError | ShareErrorTransport Sync.CodeserverTransportError @@ -535,7 +560,6 @@ isFailure o = case o of DisplayRendered {} -> False TestIncrementalOutputStart {} -> False TestIncrementalOutputEnd {} -> False - TestResults _ _ _ _ _ fails -> not (null fails) CantUndo {} -> True BustedBuiltins {} -> True NoConfiguredRemoteMapping {} -> True @@ -555,7 +579,6 @@ isFailure o = case o of MergeAlreadyUpToDate {} -> False MergeAlreadyUpToDate2 {} -> False PreviewMergeAlreadyUpToDate {} -> False - NoConflictsOrEdits {} -> False ListShallow _ es -> null es HashAmbiguous {} -> True ShowReflog {} -> False @@ -567,7 +590,6 @@ isFailure o = case o of TermMissingType {} -> True DumpUnisonFileHashes _ x y z -> x == mempty && y == mempty && z == mempty NamespaceEmpty {} -> True - RefusedToPush {} -> True GistCreated {} -> False InitiateAuthFlow {} -> False UnknownCodeServer {} -> True @@ -580,6 +602,7 @@ isFailure o = case o of ShareError {} -> True ViewOnShare {} -> False DisplayDebugCompletions {} -> False + DisplayDebugLSPNameCompletions {} -> False DebugDisplayFuzzyOptions {} -> False DebugFuzzyOptionsNoResolver {} -> True DebugTerm {} -> False @@ -631,7 +654,6 @@ isFailure o = case o of ProjectHasNoReleases {} -> True UpgradeFailure {} -> True UpgradeSuccess {} -> False - LooseCodePushDeprecated -> True MergeFailure {} -> True MergeSuccess {} -> False MergeSuccessFastForward {} -> False @@ -649,6 +671,7 @@ isFailure o = case o of UseLibInstallNotPull {} -> False PullIntoMissingBranch {} -> True NoMergeInProgress {} -> True + Output'DebugSynhashTerm {} -> False isNumberedFailure :: NumberedOutput -> Bool isNumberedFailure = \case @@ -671,4 +694,6 @@ isNumberedFailure = \case ShowDiffAfterUndo {} -> False ShowDiffNamespace _ _ _ bd -> BD.isEmpty bd ListNamespaceDependencies {} -> False - TodoOutput _ todo -> TO.todoScore todo > 0 || not (TO.noConflicts todo) + TestResults _ _ _ _ _ fails -> not (null fails) + Output'Todo {} -> False + ShowProjectBranchReflog {} -> False diff --git a/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs b/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs index 27fff49aea..47f5952d37 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs @@ -10,7 +10,7 @@ import Unison.Codebase.BranchDiff (BranchDiff (BranchDiff)) import Unison.Codebase.BranchDiff qualified as BranchDiff import Unison.Codebase.Patch qualified as P import Unison.DataDeclaration (DeclOrBuiltin) -import Unison.HashQualified' (HashQualified) +import Unison.HashQualifiedPrime (HashQualified) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index f1bf65962c..5864517034 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -14,7 +14,6 @@ import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.TypeCheck qualified as Cli (computeTypecheckingEnvironment) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -82,11 +81,12 @@ noEdits :: Edits v noEdits = Edits mempty mempty mempty mempty mempty mempty mempty propagateAndApply :: + Names -> Patch -> Branch0 IO -> Cli (Branch0 IO) -propagateAndApply patch branch = do - edits <- propagate patch branch +propagateAndApply rootNames patch branch = do + edits <- propagate rootNames patch branch let f = applyPropagate patch edits (pure . f . applyDeprecations patch) branch @@ -234,15 +234,13 @@ debugMode = False -- -- "dirty" means in need of update -- "frontier" means updated definitions responsible for the "dirty" -propagate :: Patch -> Branch0 IO -> Cli (Edits Symbol) -propagate patch b = case validatePatch patch of +propagate :: Names -> Patch -> Branch0 IO -> Cli (Edits Symbol) +propagate rootNames patch b = case validatePatch patch of Nothing -> do Cli.respond PatchNeedsToBeConflictFree pure noEdits Just (initialTermEdits, initialTypeEdits) -> do -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent` - rootNames <- Branch.toNames <$> Cli.getRootBranch0 - let -- TODO: these are just used for tracing, could be deleted if we don't care -- about printing meaningful names for definitions during propagation, or if -- we want to just remove the tracing. diff --git a/unison-cli/src/Unison/Codebase/Editor/Slurp.hs b/unison-cli/src/Unison/Codebase/Editor/Slurp.hs index 3c7e9e5239..df5f4beb60 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Slurp.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Slurp.hs @@ -21,7 +21,7 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent +import Unison.ReferentPrime qualified as Referent import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) import Unison.UnisonFile qualified as UF diff --git a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs index 33dbddf9b8..21ee27c637 100644 --- a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs +++ b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs @@ -6,7 +6,7 @@ import Unison.Codebase.Editor.Input import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Parser.Ann (Ann) import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName) diff --git a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs b/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs deleted file mode 100644 index f6458ca57b..0000000000 --- a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - -module Unison.Codebase.Editor.TodoOutput where - -import Data.Set qualified as Set -import Unison.Codebase.Editor.DisplayObject (DisplayObject (UserObject)) -import Unison.Codebase.Patch (Patch) -import Unison.Codebase.Patch qualified as Patch -import Unison.DataDeclaration (Decl) -import Unison.DataDeclaration qualified as DD -import Unison.LabeledDependency (LabeledDependency) -import Unison.LabeledDependency qualified as LD -import Unison.Names (Names) -import Unison.Names qualified as Names -import Unison.Prelude -import Unison.Reference (Reference) -import Unison.Type (Type) -import Unison.Type qualified as Type -import Unison.Util.Relation qualified as R - -type Score = Int - -data TodoOutput v a = TodoOutput - { todoScore :: Score, - todoFrontier :: - ( [(Reference, Maybe (Type v a))], - [(Reference, DisplayObject () (Decl v a))] - ), - todoFrontierDependents :: - ( [(Score, Reference, Maybe (Type v a))], - [(Score, Reference, DisplayObject () (Decl v a))] - ), - nameConflicts :: Names, - editConflicts :: Patch - } - -labeledDependencies :: (Ord v) => TodoOutput v a -> Set LabeledDependency -labeledDependencies TodoOutput {..} = - Set.fromList - ( -- term refs - [LD.termRef r | (r, _) <- fst todoFrontier] - <> [LD.termRef r | (_, r, _) <- fst todoFrontierDependents] - <> [LD.typeRef r | (r, _) <- snd todoFrontier] - <> [LD.typeRef r | (_, r, _) <- snd todoFrontierDependents] - <> - -- types of term refs - [ LD.typeRef r | (_, Just t) <- fst todoFrontier, r <- toList (Type.dependencies t) - ] - <> [ LD.typeRef r | (_, _, Just t) <- fst todoFrontierDependents, r <- toList (Type.dependencies t) - ] - <> - -- and decls of type refs - [ labeledDep | (declRef, UserObject d) <- snd todoFrontier, labeledDep <- toList (DD.labeledDeclDependenciesIncludingSelf declRef d) - ] - <> [ labeledDep | (_, declRef, UserObject d) <- snd todoFrontierDependents, labeledDep <- toList (DD.labeledDeclDependenciesIncludingSelf declRef d) - ] - ) - <> - -- name conflicts - Set.map LD.referent (R.ran (Names.terms nameConflicts)) - <> Set.map LD.typeRef (R.ran (Names.types nameConflicts)) - <> Patch.labeledDependencies editConflicts - -noConflicts :: TodoOutput v a -> Bool -noConflicts todo = - nameConflicts todo == mempty && editConflicts todo == Patch.empty - -noEdits :: TodoOutput v a -> Bool -noEdits todo = - todoScore todo == 0 diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs index cf7a99a8f9..14e7412c4e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs +++ b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs @@ -1,8 +1,7 @@ module Unison.Codebase.Editor.UriParser ( readRemoteNamespaceParser, - writeRemoteNamespace, - writeRemoteNamespaceWith, parseReadShareLooseCode, + writeRemoteNamespace, ) where @@ -17,8 +16,6 @@ import Unison.Codebase.Editor.RemoteRepo ReadShareLooseCode (..), ShareCodeserver (DefaultCodeserver), ShareUserHandle (..), - WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), ) import Unison.Codebase.Path qualified as Path import Unison.NameSegment (NameSegment) @@ -53,25 +50,9 @@ parseReadShareLooseCode label input = -- >>> P.parseMaybe writeRemoteNamespace "unisonweb.base._releases.M4" -- Just (WriteRemoteNamespaceShare (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4})) -writeRemoteNamespace :: P (WriteRemoteNamespace (These ProjectName ProjectBranchName)) +writeRemoteNamespace :: P (These ProjectName ProjectBranchName) writeRemoteNamespace = - writeRemoteNamespaceWith - (projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ProjectBranchSpecifier'Name) - -writeRemoteNamespaceWith :: P a -> P (WriteRemoteNamespace a) -writeRemoteNamespaceWith projectBranchParser = - WriteRemoteProjectBranch <$> projectBranchParser - <|> WriteRemoteNamespaceShare <$> writeShareRemoteNamespace - --- >>> P.parseMaybe writeShareRemoteNamespace "unisonweb.base._releases.M4" --- Just (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4}) -writeShareRemoteNamespace :: P WriteShareRemoteNamespace -writeShareRemoteNamespace = - P.label "write share remote namespace" $ - WriteShareRemoteNamespace - <$> pure DefaultCodeserver - <*> shareUserHandle - <*> (Path.fromList <$> P.many (C.char '.' *> nameSegment)) + (projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ProjectBranchSpecifier'Name) -- >>> P.parseMaybe readShareLooseCode ".unisonweb.base._releases.M4" -- >>> P.parseMaybe readShareLooseCode "unisonweb.base._releases.M4" diff --git a/unison-cli/src/Unison/Codebase/Transcript.hs b/unison-cli/src/Unison/Codebase/Transcript.hs new file mode 100644 index 0000000000..bd5bbd058f --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Transcript.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE PatternSynonyms #-} + +-- | The data model for Unison transcripts. +module Unison.Codebase.Transcript + ( ExpectingError, + ScratchFileName, + Hidden (..), + UcmLine (..), + UcmContext (..), + APIRequest (..), + pattern CMarkCodeBlock, + Stanza, + ProcessedBlock (..), + ) +where + +import CMark qualified +import Unison.Core.Project (ProjectBranchName, ProjectName) +import Unison.Prelude +import Unison.Project (ProjectAndBranch) + +type ExpectingError = Bool + +type ScratchFileName = Text + +data Hidden = Shown | HideOutput | HideAll + deriving (Eq, Show) + +data UcmLine + = UcmCommand UcmContext Text + | -- | Text does not include the '--' prefix. + UcmComment Text + +-- | Where a command is run: a project branch (myproject/mybranch>). +data UcmContext + = UcmContextProject (ProjectAndBranch ProjectName ProjectBranchName) + +data APIRequest + = GetRequest Text + | APIComment Text + +pattern CMarkCodeBlock :: (Maybe CMark.PosInfo) -> Text -> Text -> CMark.Node +pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info body) [] + +type Stanza = Either CMark.Node ProcessedBlock + +data ProcessedBlock + = Ucm Hidden ExpectingError [UcmLine] + | Unison Hidden ExpectingError (Maybe ScratchFileName) Text + | API [APIRequest] diff --git a/unison-cli/src/Unison/Codebase/Transcript/Parser.hs b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs new file mode 100644 index 0000000000..8bbd8be622 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs @@ -0,0 +1,166 @@ +-- | Parse and print CommonMark (like Github-flavored Markdown) transcripts. +module Unison.Codebase.Transcript.Parser + ( -- * printing + formatAPIRequest, + formatUcmLine, + formatStanza, + formatNode, + formatProcessedBlock, + + -- * conversion + processedBlockToNode, + + -- * parsing + stanzas, + ucmLine, + apiRequest, + fenced, + hidden, + expectingError, + language, + ) +where + +import CMark qualified +import Data.Char qualified as Char +import Data.Text qualified as Text +import Data.These (These (..)) +import Text.Megaparsec qualified as P +import Unison.Codebase.Transcript +import Unison.Prelude +import Unison.Project (ProjectAndBranch (ProjectAndBranch)) + +formatAPIRequest :: APIRequest -> Text +formatAPIRequest = \case + GetRequest txt -> "GET " <> txt + APIComment txt -> "-- " <> txt + +formatUcmLine :: UcmLine -> Text +formatUcmLine = \case + UcmCommand context txt -> formatContext context <> "> " <> txt + UcmComment txt -> "--" <> txt + where + formatContext (UcmContextProject projectAndBranch) = into @Text projectAndBranch + +formatStanza :: Stanza -> Text +formatStanza = either formatNode formatProcessedBlock + +formatNode :: CMark.Node -> Text +formatNode = (<> "\n") . CMark.nodeToCommonmark [] Nothing + +formatProcessedBlock :: ProcessedBlock -> Text +formatProcessedBlock = formatNode . processedBlockToNode + +processedBlockToNode :: ProcessedBlock -> CMark.Node +processedBlockToNode = \case + Ucm _ _ cmds -> CMarkCodeBlock Nothing "ucm" $ foldr ((<>) . formatUcmLine) "" cmds + Unison _hide _ fname txt -> + CMarkCodeBlock Nothing "unison" $ maybe txt (\fname -> Text.unlines ["---", "title: " <> fname, "---", txt]) fname + API apiRequests -> CMarkCodeBlock Nothing "api" $ Text.unlines $ formatAPIRequest <$> apiRequests + +type P = P.Parsec Void Text + +stanzas :: FilePath -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza] +stanzas srcName = (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromNode blocks) . CMark.commonmarkToNode [] + where + stanzaFromNode :: CMark.Node -> Either (P.ParseErrorBundle Text Void) Stanza + stanzaFromNode node = case node of + CMarkCodeBlock _ info body -> maybe (Left node) pure <$> P.parse (fenced info) srcName body + _ -> pure $ Left node + +ucmLine :: P UcmLine +ucmLine = ucmCommand <|> ucmComment + where + ucmCommand :: P UcmLine + ucmCommand = do + context <- + P.try do + contextString <- P.takeWhile1P Nothing (/= '>') + context <- + case (tryFrom @Text contextString) of + (Right (These project branch)) -> pure (UcmContextProject (ProjectAndBranch project branch)) + _ -> fail "expected project/branch or absolute path" + void $ lineToken $ word ">" + pure context + line <- P.takeWhileP Nothing (/= '\n') <* spaces + pure $ UcmCommand context line + + ucmComment :: P UcmLine + ucmComment = do + word "--" + line <- P.takeWhileP Nothing (/= '\n') <* spaces + pure $ UcmComment line + +apiRequest :: P APIRequest +apiRequest = do + apiComment <|> getRequest + where + getRequest = do + word "GET" + spaces + path <- P.takeWhile1P Nothing (/= '\n') + spaces + pure (GetRequest path) + apiComment = do + word "--" + comment <- P.takeWhileP Nothing (/= '\n') + spaces + pure (APIComment comment) + +-- | Produce the correct parser for the code block based on the provided info string. +fenced :: Text -> P (Maybe ProcessedBlock) +fenced info = do + body <- P.getInput + P.setInput info + fenceType <- lineToken (word "ucm" <|> word "unison" <|> word "api" <|> language) + case fenceType of + "ucm" -> do + hide <- hidden + err <- expectingError + P.setInput body + pure . Ucm hide err <$> (spaces *> many ucmLine) + "unison" -> + do + -- todo: this has to be more interesting + -- ```unison:hide + -- ```unison + -- ```unison:hide:all scratch.u + hide <- lineToken hidden + err <- lineToken expectingError + fileName <- optional untilSpace1 + P.setInput body + pure . Unison hide err fileName <$> (spaces *> P.getInput) + "api" -> do + P.setInput body + pure . API <$> (spaces *> many apiRequest) + _ -> pure Nothing + +word :: Text -> P Text +word txt = P.try $ do + chs <- P.takeP (Just $ show txt) (Text.length txt) + guard (chs == txt) + pure txt + +lineToken :: P a -> P a +lineToken p = p <* nonNewlineSpaces + +nonNewlineSpaces :: P () +nonNewlineSpaces = void $ P.takeWhileP Nothing (\ch -> ch == ' ' || ch == '\t') + +hidden :: P Hidden +hidden = + (HideAll <$ word ":hide:all") + <|> (HideOutput <$ word ":hide") + <|> pure Shown + +expectingError :: P ExpectingError +expectingError = isJust <$> optional (word ":error") + +untilSpace1 :: P Text +untilSpace1 = P.takeWhile1P Nothing (not . Char.isSpace) + +language :: P Text +language = P.takeWhileP Nothing (\ch -> Char.isDigit ch || Char.isLower ch || ch == '_') + +spaces :: P () +spaces = void $ P.takeWhileP (Just "spaces") Char.isSpace diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs similarity index 58% rename from unison-cli/src/Unison/Codebase/TranscriptParser.hs rename to unison-cli/src/Unison/Codebase/Transcript/Runner.hs index b9e82f7ed5..6e084a2eba 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs @@ -1,20 +1,10 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} -{- Parse and execute markdown transcripts. --} -module Unison.Codebase.TranscriptParser - ( Stanza (..), - FenceType, - ExpectingError, - Hidden, - TranscriptError (..), - UcmLine (..), - withTranscriptRunner, - parse, - parseFile, +-- | Execute transcripts. +module Unison.Codebase.Transcript.Runner + ( Error (..), + Runner, + withRunner, ) where @@ -23,25 +13,22 @@ 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.Char qualified as Char 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 import Data.Map qualified as Map import Data.Text qualified as Text import Data.These (These (..)) import Data.UUID.V4 qualified as UUID -import Ki qualified import Network.HTTP.Client qualified as HTTP -import System.Directory (doesFileExist) 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.Operations qualified as Operations import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q @@ -51,16 +38,16 @@ import Unison.Auth.Tokens qualified as AuthN import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event (UnisonFileChanged), Input (..)) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.UCMVersion (UCMVersion) -import Unison.Codebase.Path qualified as Path -import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime +import Unison.Codebase.Transcript +import Unison.Codebase.Transcript.Parser qualified as Transcript import Unison.Codebase.Verbosity (Verbosity, isSilent) import Unison.Codebase.Verbosity qualified as Verbosity import Unison.CommandLine @@ -71,7 +58,7 @@ import Unison.CommandLine.Welcome (asciiartUnison) import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyTerminal -import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (ProjectAndBranchNames'Unambiguous), ProjectBranchName, ProjectName) +import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (ProjectAndBranchNames'Unambiguous)) import Unison.Runtime.Interface qualified as RTI import Unison.Server.Backend qualified as Backend import Unison.Server.CodebaseServer qualified as Server @@ -95,125 +82,31 @@ terminalWidth = 65 accessTokenEnvVarKey :: String accessTokenEnvVarKey = "UNISON_SHARE_ACCESS_TOKEN" -type ExpectingError = Bool - -type ScratchFileName = Text - -type FenceType = Text - -data Hidden = Shown | HideOutput | HideAll - deriving (Eq, Show) - -data UcmLine - = UcmCommand UcmContext Text - | UcmComment Text -- Text does not include the '--' prefix. - --- | Where a command is run: either loose code (.foo.bar.baz>) or a project branch (myproject/mybranch>). -data UcmContext - = UcmContextLooseCode Path.Absolute - | UcmContextProject (ProjectAndBranch ProjectName ProjectBranchName) - -data APIRequest - = GetRequest Text - | APIComment Text - -instance Show APIRequest where - show (GetRequest txt) = "GET " <> Text.unpack txt - show (APIComment txt) = "-- " <> Text.unpack txt - -data Stanza - = Ucm Hidden ExpectingError [UcmLine] - | Unison Hidden ExpectingError (Maybe ScratchFileName) Text - | API [APIRequest] - | UnprocessedFence FenceType Text - | Unfenced Text - -instance Show UcmLine where - show = \case - UcmCommand context txt -> showContext context <> "> " <> Text.unpack txt - UcmComment txt -> "--" ++ Text.unpack txt - where - showContext = \case - UcmContextLooseCode path -> show path - UcmContextProject projectAndBranch -> Text.unpack (into @Text projectAndBranch) - -instance Show Stanza where - show s = case s of - Ucm _ _ cmds -> - unlines - [ "```ucm", - foldl (\x y -> x ++ show y) "" cmds, - "```" - ] - Unison _hide _ fname txt -> - unlines - [ "```unison", - case fname of - Nothing -> Text.unpack txt <> "```\n" - Just fname -> - unlines - [ "---", - "title: " <> Text.unpack fname, - "---", - Text.unpack txt, - "```", - "" - ] - ] - API apiRequests -> - "```api\n" - <> ( apiRequests - & fmap show - & unlines - ) - <> "```\n" - UnprocessedFence typ txt -> - unlines - [ "```" <> Text.unpack typ, - Text.unpack txt, - "```", - "" - ] - Unfenced txt -> Text.unpack txt - -parseFile :: FilePath -> IO (Either TranscriptError [Stanza]) -parseFile filePath = do - exists <- doesFileExist filePath - if exists - then do - txt <- readUtf8 filePath - pure $ parse filePath txt - else pure . Left . TranscriptParseError . Text.pack $ filePath <> " does not exist" - -parse :: String -> Text -> Either TranscriptError [Stanza] -parse srcName txt = case P.parse (stanzas <* P.eof) srcName txt of - Right a -> Right a - Left e -> Left . TranscriptParseError . Text.pack . P.errorBundlePretty $ e - -type TranscriptRunner = - ( String -> - Text -> - (FilePath, Codebase IO Symbol Ann) -> - IO (Either TranscriptError Text) - ) +type Runner = + String -> + Text -> + (FilePath, Codebase IO Symbol Ann) -> + IO (Either Error Text) -withTranscriptRunner :: +withRunner :: forall m r. (UnliftIO.MonadUnliftIO m) => + -- | Whether to treat this transcript run as a transcript test, which will try to make output deterministic + Bool -> Verbosity -> UCMVersion -> FilePath -> Maybe FilePath -> - (TranscriptRunner -> m r) -> + (Runner -> m r) -> m r -withTranscriptRunner verbosity ucmVersion nrtp configFile action = do +withRunner isTest verbosity ucmVersion nrtp configFile action = do withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do action \transcriptName transcriptSrc (codebaseDir, codebase) -> do Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do - let parsed = parse transcriptName transcriptSrc + let parsed = Transcript.stanzas transcriptName transcriptSrc result <- for parsed \stanzas -> do - liftIO $ run verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) - pure $ join @(Either TranscriptError) result + liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) + pure . join $ first ParseError result where withRuntimes :: FilePath -> (Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> m a) -> m a @@ -237,6 +130,8 @@ withTranscriptRunner verbosity ucmVersion nrtp configFile action = do (\(config, _cancelConfig) -> action (Just config)) run :: + -- | Whether to treat this transcript run as a transcript test, which will try to make output deterministic + Bool -> Verbosity -> FilePath -> [Stanza] -> @@ -247,10 +142,14 @@ run :: Maybe Config -> UCMVersion -> Text -> - IO (Either TranscriptError Text) -run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try $ Ki.scoped \scope -> do + IO (Either Error Text) +run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do httpManager <- HTTP.newManager HTTP.defaultManagerSettings - let initialPath = Path.absoluteEmpty + (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do + (_, emptyCausalHashId) <- Codebase.emptyCausalHash + initialPP <- Codebase.expectCurrentProjectPath + pure (initialPP, emptyCausalHashId) + unless (isSilent verbosity) . putPrettyLn $ Pretty.lines [ asciiartUnison, @@ -258,11 +157,6 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion "Running the provided transcript file...", "" ] - initialRootCausalHash <- Codebase.runTransaction codebase Operations.expectRootCausalHash - rootVar <- newEmptyTMVarIO - void $ Ki.fork scope do - root <- Codebase.getRootBranch codebase - atomically $ putTMVar rootVar root mayShareAccessToken <- fmap Text.pack <$> lookupEnv accessTokenEnvVarKey credMan <- AuthN.newCredentialManager let tokenProvider :: AuthN.TokenProvider @@ -309,7 +203,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion apiRequest :: APIRequest -> IO () apiRequest req = do - output (show req <> "\n") + output . Text.unpack $ Transcript.formatAPIRequest req <> "\n" case req of APIComment {} -> pure () GetRequest path -> do @@ -337,24 +231,20 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion for (reverse scratchFileUpdates) \(fp, contents) -> do let fenceDescription = "unison:added-by-ucm " <> fp -- Output blocks for any scratch file updates the ucm block triggered. - Q.undequeue inputQueue (UnprocessedFence fenceDescription contents, Nothing) + Q.undequeue inputQueue (Left $ CMarkCodeBlock Nothing fenceDescription contents, Nothing) awaitInput -- ucm command to run Just (Just ucmLine) -> do case ucmLine of p@(UcmComment {}) -> do - liftIO (output ("\n" <> show p)) + liftIO . output . Text.unpack $ "\n" <> Transcript.formatUcmLine p awaitInput p@(UcmCommand context lineTxt) -> do - curPath <- Cli.getCurrentPath + curPath <- Cli.getCurrentProjectPath -- We're either going to run the command now (because we're in the right context), else we'll switch to -- the right context first, then run the command next. maybeSwitchCommand <- case context of - UcmContextLooseCode path -> - if curPath == path - then pure Nothing - else pure $ Just (SwitchBranchI (Path.absoluteToPath' path)) UcmContextProject (ProjectAndBranch projectName branchName) -> Cli.runTransaction do Project {projectId, name = projectName} <- Q.loadProjectByName projectName @@ -369,12 +259,12 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion Nothing -> do branchId <- Sqlite.unsafeIO (Db.ProjectBranchId <$> UUID.nextRandom) let projectBranch = ProjectBranch {projectId, parentBranchId = Nothing, branchId, name = branchName} - Q.insertProjectBranch projectBranch + Q.insertProjectBranch "Branch Created" emptyCausalHashId projectBranch pure projectBranch Just projBranch -> pure projBranch let projectAndBranchIds = ProjectAndBranch projectBranch.projectId projectBranch.branchId pure - if curPath == ProjectUtils.projectBranchPath projectAndBranchIds + if (PP.toProjectAndBranch . PP.toIds $ curPath) == projectAndBranchIds then Nothing else Just (ProjectSwitchI (ProjectAndBranchNames'Unambiguous (These projectName branchName))) case maybeSwitchCommand of @@ -385,9 +275,11 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion case words . Text.unpack $ lineTxt of [] -> awaitInput args -> do - liftIO (output ("\n" <> show p <> "\n")) + liftIO . output . Text.unpack $ "\n" <> Transcript.formatUcmLine p <> "\n" numberedArgs <- use #numberedArgs - liftIO (parseInput codebase curPath numberedArgs patternMap args) >>= \case + PP.ProjectAndBranch projId branchId <- PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack + let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId + liftIO (parseInput codebase curPath getProjectRoot numberedArgs patternMap args) >>= \case -- invalid command is treated as a failure Left msg -> do liftIO $ writeIORef hasErrors True @@ -419,38 +311,39 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion ++ show (length stanzas) ++ "." IO.hFlush IO.stdout - case s of - Unfenced _ -> do - liftIO (output $ show s) - awaitInput - UnprocessedFence _ _ -> do - liftIO (output $ show s) - awaitInput - Unison hide errOk filename txt -> do - liftIO (writeIORef hidden hide) - liftIO (outputEcho $ show s) - liftIO (writeIORef allowErrors errOk) - -- Open a ucm block which will contain the output from UCM - -- after processing the UnisonFileChanged event. - liftIO (output "```ucm\n") - -- Close the ucm block after processing the UnisonFileChanged event. - atomically . Q.enqueue cmdQueue $ Nothing - let sourceName = fromMaybe "scratch.u" filename - liftIO $ updateVirtualFile sourceName txt - pure $ Left (UnisonFileChanged sourceName txt) - API apiRequests -> do - liftIO (output "```api\n") - liftIO (for_ apiRequests apiRequest) - liftIO (output "```") - awaitInput - Ucm hide errOk cmds -> do - liftIO (writeIORef hidden hide) - liftIO (writeIORef allowErrors errOk) - liftIO (writeIORef hasErrors False) - liftIO (output "```ucm") - traverse_ (atomically . Q.enqueue cmdQueue . Just) cmds - atomically . Q.enqueue cmdQueue $ Nothing - awaitInput + either + ( \node -> do + liftIO . output . Text.unpack $ Transcript.formatNode node + awaitInput + ) + ( \block -> case block of + Unison hide errOk filename txt -> do + liftIO (writeIORef hidden hide) + liftIO . outputEcho . Text.unpack $ Transcript.formatProcessedBlock block + liftIO (writeIORef allowErrors errOk) + -- Open a ucm block which will contain the output from UCM + -- after processing the UnisonFileChanged event. + liftIO (output "``` ucm\n") + -- Close the ucm block after processing the UnisonFileChanged event. + atomically . Q.enqueue cmdQueue $ Nothing + let sourceName = fromMaybe "scratch.u" filename + liftIO $ updateVirtualFile sourceName txt + pure $ Left (UnisonFileChanged sourceName txt) + API apiRequests -> do + liftIO (output "``` api\n") + liftIO (for_ apiRequests apiRequest) + liftIO (output "```\n\n") + awaitInput + Ucm hide errOk cmds -> do + liftIO (writeIORef hidden hide) + liftIO (writeIORef allowErrors errOk) + liftIO (writeIORef hasErrors False) + liftIO (output "``` ucm") + traverse_ (atomically . Q.enqueue cmdQueue . Just) cmds + atomically . Q.enqueue cmdQueue $ Nothing + awaitInput + ) + s loadPreviousUnisonBlock name = do ufs <- readIORef unisonFiles @@ -507,7 +400,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion appendFailingStanza = do stanzaOpt <- readIORef mStanza currentOut <- readIORef out - let stnz = maybe "" show (fmap fst stanzaOpt :: Maybe Stanza) + let stnz = maybe "" (Text.unpack . Transcript.formatStanza . fst) stanzaOpt unless (stnz `isSubsequenceOf` concat currentOut) $ modifyIORef' out (\acc -> acc <> pure stnz) @@ -517,13 +410,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion output "\n```\n\n" appendFailingStanza transcriptFailure out $ - Text.unlines - [ "\128721", - "", - "The transcript failed due to an error in the stanza above. The error is:", - "", - Text.pack msg - ] + "The transcript failed due to an error in the stanza above. The error is:\n\n" <> Text.pack msg dieUnexpectedSuccess :: IO () dieUnexpectedSuccess = do @@ -532,12 +419,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion when (errOk && not hasErr) $ do output "\n```\n\n" appendFailingStanza - transcriptFailure out $ - Text.unlines - [ "\128721", - "", - "The transcript was expecting an error in the stanza above, but did not encounter one." - ] + transcriptFailure out "The transcript was expecting an error in the stanza above, but did not encounter one." authenticatedHTTPClient <- AuthN.newAuthenticatedHTTPClient tokenProvider ucmVersion @@ -558,7 +440,8 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion sandboxedRuntime = sbRuntime, nativeRuntime = nRuntime, serverBaseUrl = Nothing, - ucmVersion + ucmVersion, + isTranscriptTest = isTest } let loop :: Cli.LoopState -> IO Text @@ -580,163 +463,15 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion texts <- readIORef out pure $ Text.concat (Text.pack <$> toList (texts :: Seq String)) - loop (Cli.loopState0 initialRootCausalHash rootVar initialPath) + loop (Cli.loopState0 (PP.toIds initialPP)) transcriptFailure :: IORef (Seq String) -> Text -> IO b transcriptFailure out msg = do texts <- readIORef out - UnliftIO.throwIO - . TranscriptRunFailure - $ Text.concat (Text.pack <$> toList texts) - <> "\n\n" - <> msg - -type P = P.Parsec Void Text - -stanzas :: P [Stanza] -stanzas = P.many (fenced <|> unfenced) - -ucmLine :: P UcmLine -ucmLine = ucmCommand <|> ucmComment - where - ucmCommand :: P UcmLine - ucmCommand = do - context <- - P.try do - contextString <- P.takeWhile1P Nothing (/= '>') - context <- - case (tryFrom @Text contextString, Path.parsePath' (Text.unpack contextString)) of - (Right (These project branch), _) -> pure (UcmContextProject (ProjectAndBranch project branch)) - (Left _, Right (Path.unPath' -> Left abs)) -> pure (UcmContextLooseCode abs) - _ -> fail "expected project/branch or absolute path" - void $ lineToken $ word ">" - pure context - line <- P.takeWhileP Nothing (/= '\n') <* spaces - pure $ UcmCommand context line - - ucmComment :: P UcmLine - ucmComment = do - word "--" - line <- P.takeWhileP Nothing (/= '\n') <* spaces - pure $ UcmComment line - -apiRequest :: P APIRequest -apiRequest = do - apiComment <|> getRequest - where - getRequest = do - word "GET" - spaces - path <- P.takeWhile1P Nothing (/= '\n') - spaces - pure (GetRequest path) - apiComment = do - word "--" - comment <- P.takeWhileP Nothing (/= '\n') - spaces - pure (APIComment comment) - -fenced :: P Stanza -fenced = do - fence - fenceType <- lineToken (word "ucm" <|> word "unison" <|> word "api" <|> language) - stanza <- - case fenceType of - "ucm" -> do - hide <- hidden - err <- expectingError - _ <- spaces - cmds <- many ucmLine - pure $ Ucm hide err cmds - "unison" -> - do - -- todo: this has to be more interesting - -- ```unison:hide - -- ```unison - -- ```unison:hide:all scratch.u - hide <- lineToken hidden - err <- lineToken expectingError - fileName <- optional untilSpace1 - blob <- spaces *> untilFence - pure $ Unison hide err fileName blob - "api" -> do - _ <- spaces - apiRequests <- many apiRequest - pure $ API apiRequests - _ -> UnprocessedFence fenceType <$> untilFence - fence - pure stanza - --- Three backticks, consumes trailing spaces too --- ``` -fence :: P () -fence = P.try $ do void (word "```"); spaces - --- Parses up until next fence -unfenced :: P Stanza -unfenced = Unfenced <$> untilFence - -untilFence :: P Text -untilFence = do - _ <- P.lookAhead (P.takeP Nothing 1) - go mempty - where - go :: Seq Text -> P Text - go !acc = do - f <- P.lookAhead (P.optional fence) - case f of - Nothing -> do - oneOrTwoBackticks <- optional (word' "``" <|> word' "`") - let start = fromMaybe "" oneOrTwoBackticks - txt <- P.takeWhileP (Just "unfenced") (/= '`') - eof <- P.lookAhead (P.optional P.eof) - case eof of - Just _ -> pure $ fold (acc <> pure txt) - Nothing -> go (acc <> pure start <> pure txt) - Just _ -> pure $ fold acc - -word' :: Text -> P Text -word' txt = P.try $ do - chs <- P.takeP (Just $ show txt) (Text.length txt) - guard (chs == txt) - pure txt - -word :: Text -> P Text -word = word' - --- token :: P a -> P a --- token p = p <* spaces - -lineToken :: P a -> P a -lineToken p = p <* nonNewlineSpaces - -nonNewlineSpaces :: P () -nonNewlineSpaces = void $ P.takeWhileP Nothing (\ch -> ch == ' ' || ch == '\t') - -hidden :: P Hidden -hidden = (\case Just x -> x; Nothing -> Shown) <$> optional go - where - go = - ((\_ -> HideAll) <$> (word ":hide:all")) - <|> ((\_ -> HideOutput) <$> (word ":hide")) - -expectingError :: P ExpectingError -expectingError = isJust <$> optional (word ":error") - -untilSpace1 :: P Text -untilSpace1 = P.takeWhile1P Nothing (not . Char.isSpace) - -language :: P Text -language = P.takeWhileP Nothing (\ch -> Char.isDigit ch || Char.isLower ch || ch == '_') - -spaces :: P () -spaces = void $ P.takeWhileP (Just "spaces") Char.isSpace - --- single :: Char -> P Char --- single t = P.satisfy (== t) + UnliftIO.throwIO . RunFailure $ mconcat (Text.pack <$> toList texts) <> "\n\n\128721\n\n" <> msg <> "\n" -data TranscriptError - = TranscriptRunFailure Text - | TranscriptParseError Text +data Error + = ParseError (P.ParseErrorBundle Text Void) + | RunFailure Text deriving stock (Show) deriving anyclass (Exception) diff --git a/unison-cli/src/Unison/Codebase/Watch.hs b/unison-cli/src/Unison/Codebase/Watch.hs index 54838c7a86..c587d6ece5 100644 --- a/unison-cli/src/Unison/Codebase/Watch.hs +++ b/unison-cli/src/Unison/Codebase/Watch.hs @@ -44,8 +44,8 @@ watchDirectory' d = do mvar <- newEmptyMVar let handler :: Event -> IO () handler e = case e of - Added fp t False -> doIt fp t - Modified fp t False -> doIt fp t + Added fp t FSNotify.IsFile -> doIt fp t + Modified fp t FSNotify.IsFile -> doIt fp t _ -> pure () where doIt fp t = do @@ -56,7 +56,7 @@ watchDirectory' d = do cleanupRef <- newEmptyMVar -- we don't like FSNotify's debouncing (it seems to drop later events) -- so we will be doing our own instead - let config = FSNotify.defaultConfig {FSNotify.confDebounce = FSNotify.NoDebounce} + let config = FSNotify.defaultConfig cancel <- liftIO $ forkIO $ FSNotify.withManagerConf config $ \mgr -> do diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 2c8be9bf43..168e264894 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -3,21 +3,7 @@ {-# LANGUAGE ViewPatterns #-} module Unison.CommandLine - ( -- * Pretty Printing - allow, - backtick, - aside, - bigproblem, - note, - nothingTodo, - plural, - plural', - problem, - tip, - warn, - warnNote, - - -- * Other + ( allow, parseInput, prompt, watchConfig, @@ -26,13 +12,13 @@ module Unison.CommandLine where 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.ListLike (ListLike) import Data.Map qualified as Map import Data.Semialign qualified as Align import Data.Text qualified as Text @@ -42,20 +28,20 @@ import Data.Vector qualified as Vector import System.FilePath (takeFileName) import Text.Regex.TDFA ((=~)) import Unison.Codebase (Codebase) -import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (Event (..), Input (..)) import Unison.Codebase.Editor.Output (NumberedArgs) -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Watch qualified as Watch import Unison.CommandLine.FZFResolvers qualified as FZFResolvers import Unison.CommandLine.FuzzySelect qualified as Fuzzy +import Unison.CommandLine.Helpers (warn) import Unison.CommandLine.InputPattern (InputPattern (..)) import Unison.CommandLine.InputPattern qualified as InputPattern +import Unison.CommandLine.InputPatterns qualified as IPs import Unison.Parser.Ann (Ann) import Unison.Prelude -import Unison.Project.Util (ProjectContext, projectContextFromPath) import Unison.Symbol (Symbol) import Unison.Util.ColorText qualified as CT import Unison.Util.Monoid (foldMapM) @@ -89,40 +75,11 @@ watchFileSystem q dir = do atomically . Q.enqueue q $ UnisonFileChanged (Text.pack filePath) text pure (cancel >> killThread t) -warnNote :: String -> String -warnNote s = "⚠️ " <> s - -backtick :: (IsString s) => P.Pretty s -> P.Pretty s -backtick s = P.group ("`" <> s <> "`") - -tip :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -tip s = P.column2 [("Tip:", P.wrap s)] - -note :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -note s = P.column2 [("Note:", P.wrap s)] - -aside :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -> P.Pretty s -aside a b = P.column2 [(a <> ":", b)] - -warn :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -warn = emojiNote "⚠️" - -problem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -problem = emojiNote "❗️" - -bigproblem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -bigproblem = emojiNote "‼️" - -emojiNote :: (ListLike s Char, IsString s) => String -> P.Pretty s -> P.Pretty s -emojiNote lead s = P.group (fromString lead) <> "\n" <> P.wrap s - -nothingTodo :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -nothingTodo = emojiNote "😶" - parseInput :: Codebase IO Symbol Ann -> - -- | Current path from root - Path.Absolute -> + -- | Current location + PP.ProjectPath -> + IO (Branch.Branch IO) -> -- | Numbered arguments NumberedArgs -> -- | Input Pattern Map @@ -132,10 +89,11 @@ parseInput :: -- Returns either an error message or the fully expanded arguments list and parsed input. -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c) IO (Either (P.Pretty CT.ColorText) (Maybe (InputPattern.Arguments, Input))) -parseInput codebase currentPath numberedArgs patterns segments = runExceptT do +parseInput codebase projPath currentProjectRoot numberedArgs patterns segments = runExceptT do let getCurrentBranch0 :: IO (Branch0 IO) - getCurrentBranch0 = Branch.head <$> Codebase.getBranchAtPath codebase currentPath - let projCtx = projectContextFromPath currentPath + getCurrentBranch0 = do + projRoot <- currentProjectRoot + pure . Branch.head $ Branch.getAt' (projPath ^. PP.path_) projRoot case segments of [] -> throwE "" @@ -144,20 +102,40 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do let expandedNumbers :: InputPattern.Arguments expandedNumbers = foldMap (\arg -> maybe [Left arg] (fmap pure) $ expandNumber numberedArgs arg) args - lift (fzfResolve codebase projCtx getCurrentBranch0 pat expandedNumbers) >>= \case + lift (fzfResolve codebase projPath getCurrentBranch0 pat expandedNumbers) >>= \case Left (NoFZFResolverForArgumentType _argDesc) -> throwError help Left (NoFZFOptions argDesc) -> throwError (noCompletionsMessage argDesc) Left FZFCancelled -> pure Nothing Right resolvedArgs -> do - parsedInput <- except . parse $ resolvedArgs + parsedInput <- + except + . first + ( \msg -> + P.warnCallout $ + P.wrap "Sorry, I wasn’t sure how to process your request:" + <> P.newline + <> P.newline + <> P.indentN 2 msg + <> P.newline + <> P.newline + <> P.wrap + ( "You can run" + <> IPs.makeExample IPs.help [fromString command] + <> "for more information on using" + <> IPs.makeExampleEOS pat [] + ) + ) + $ parse resolvedArgs pure $ Just (Left command : resolvedArgs, parsedInput) Nothing -> throwE . warn . P.wrap - $ "I don't know how to " + $ "I don't know how to" <> P.group (fromString command <> ".") - <> "Type `help` or `?` to get help." + <> "Type" + <> IPs.makeExample' IPs.help + <> "or `?` to get help." where noCompletionsMessage argDesc = P.callout "⚠️" $ @@ -192,8 +170,8 @@ data FZFResolveFailure | NoFZFOptions Text {- argument description -} | FZFCancelled -fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> InputPattern.Arguments -> IO (Either FZFResolveFailure InputPattern.Arguments) -fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do +fzfResolve :: Codebase IO Symbol Ann -> PP.ProjectPath -> (IO (Branch0 IO)) -> InputPattern -> InputPattern.Arguments -> IO (Either FZFResolveFailure InputPattern.Arguments) +fzfResolve codebase ppCtx getCurrentBranch pat args = runExceptT do -- We resolve args in two steps, first we check that all arguments that will require a fzf -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search. -- Otherwise, we might ask the user to perform a search only to realize we don't have a resolver @@ -214,7 +192,7 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO InputPattern.Arguments fuzzyFillArg opt argDesc InputPattern.FZFResolver {getOptions} = do currentBranch <- Branch.withoutTransitiveLibs <$> liftIO getCurrentBranch - options <- liftIO $ getOptions codebase projCtx currentBranch + options <- liftIO $ getOptions codebase ppCtx currentBranch when (null options) $ throwError $ NoFZFOptions argDesc liftIO $ Text.putStrLn (FZFResolvers.fuzzySelectHeader argDesc) results <- @@ -235,15 +213,3 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do prompt :: String prompt = "> " - --- `plural [] "cat" "cats" = "cats"` --- `plural ["meow"] "cat" "cats" = "cat"` --- `plural ["meow", "meow"] "cat" "cats" = "cats"` -plural :: (Foldable f) => f a -> b -> b -> b -plural items one other = case toList items of - [_] -> one - _ -> other - -plural' :: (Integral a) => a -> b -> b -> b -plural' 1 one _other = one -plural' _ _one other = other diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs index 7e0a0682ac..cc49baa3ce 100644 --- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -2,9 +2,9 @@ module Unison.CommandLine.BranchRelativePath ( BranchRelativePath (..), parseBranchRelativePath, branchRelativePathParser, - ResolvedBranchRelativePath (..), parseIncrementalBranchRelativePath, IncrementalBranchRelativePath (..), + toText, ) where @@ -14,10 +14,9 @@ import Data.These (These (..)) import Text.Builder qualified import Text.Megaparsec qualified as Megaparsec import Text.Megaparsec.Char qualified as Megaparsec -import U.Codebase.Sqlite.Project qualified as Sqlite -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Project qualified as Project @@ -25,8 +24,11 @@ import Unison.Util.ColorText qualified as CT import Unison.Util.Pretty qualified as P data BranchRelativePath - = BranchRelative (These (Either ProjectBranchName (ProjectName, ProjectBranchName)) Path.Relative) - | LoosePath Path.Path' + = -- | A path rooted at some specified branch/project + BranchPathInCurrentProject ProjectBranchName Path.Absolute + | QualifiedBranchPath ProjectName ProjectBranchName Path.Absolute + | -- | A path which is relative to the user's current location. + UnqualifiedPath Path.Path' deriving stock (Eq, Show) -- | Strings without colons are parsed as loose code paths. A path with a colon may specify: @@ -37,72 +39,56 @@ data BranchRelativePath -- Specifying only a project is not allowed. -- -- >>> parseBranchRelativePath "foo" --- Right (LoosePath foo) +-- Right (UnqualifiedPath foo) -- >>> parseBranchRelativePath "foo/bar:" --- Right (BranchRelative (This (Right (UnsafeProjectName "foo",UnsafeProjectBranchName "bar")))) --- >>> parseBranchRelativePath "foo/bar:some.path" --- Right (BranchRelative (These (Right (UnsafeProjectName "foo",UnsafeProjectBranchName "bar")) some.path)) --- >>> parseBranchRelativePath "/bar:some.path" --- Right (BranchRelative (These (Left (UnsafeProjectBranchName "bar")) some.path)) --- >>> parseBranchRelativePath ":some.path" --- Right (BranchRelative (That some.path)) +-- Right (QualifiedBranchPath (UnsafeProjectName "foo") (UnsafeProjectBranchName "bar") .) +-- >>> parseBranchRelativePath "foo/bar:.some.path" +-- Right (QualifiedBranchPath (UnsafeProjectName "foo") (UnsafeProjectBranchName "bar") .some.path) +-- >>> parseBranchRelativePath "/bar:.some.path" +-- Right (BranchPathInCurrentProject (UnsafeProjectBranchName "bar") .some.path) +-- >>> parseBranchRelativePath ":.some.path" +-- Right (UnqualifiedPath .some.path) +-- +-- >>> parseBranchRelativePath ".branch" +-- Right (UnqualifiedPath .branch) parseBranchRelativePath :: String -> Either (P.Pretty CT.ColorText) BranchRelativePath parseBranchRelativePath str = case Megaparsec.parse branchRelativePathParser "" (Text.pack str) of Left e -> Left (P.string (Megaparsec.errorBundlePretty e)) Right x -> Right x +-- | +-- >>> from @BranchRelativePath @Text (BranchPathInCurrentProject "foo" (Path.absoluteEmpty "bar")) instance From BranchRelativePath Text where from = \case - BranchRelative brArg -> case brArg of - This eitherProj -> - Text.Builder.run - ( Text.Builder.text (eitherProjToText eitherProj) - <> Text.Builder.char ':' - ) - That path -> - Text.Builder.run - ( Text.Builder.char ':' - <> Text.Builder.text (Path.toText' $ Path.RelativePath' path) - ) - These eitherProj path -> - Text.Builder.run - ( Text.Builder.text (eitherProjToText eitherProj) - <> Text.Builder.char ':' - <> Text.Builder.text (Path.toText' $ Path.RelativePath' path) - ) - LoosePath path -> Path.toText' path - where - eitherProjToText = \case - Left branchName -> from @(These ProjectName ProjectBranchName) @Text (That branchName) - Right (projName, branchName) -> into @Text (These projName branchName) - -data ResolvedBranchRelativePath - = ResolvedBranchRelative (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) (Maybe Path.Relative) - | ResolvedLoosePath Path.Absolute - -instance From ResolvedBranchRelativePath BranchRelativePath where - from = \case - ResolvedBranchRelative (ProjectAndBranch proj branch) mRel -> case mRel of - Nothing -> BranchRelative (This (Right (view #name proj, view #name branch))) - Just rel -> BranchRelative (These (Right (view #name proj, view #name branch)) rel) - ResolvedLoosePath p -> LoosePath (Path.absoluteToPath' p) - -instance From ResolvedBranchRelativePath Text where - from = from . into @BranchRelativePath + BranchPathInCurrentProject branch path -> + Text.Builder.run $ + Text.Builder.char '/' + <> Text.Builder.text (into @Text branch) + <> Text.Builder.char ':' + <> Text.Builder.text (Path.absToText path) + QualifiedBranchPath proj branch path -> + Text.Builder.run $ + Text.Builder.text (into @Text proj) + <> Text.Builder.char '/' + <> Text.Builder.text (into @Text branch) + <> Text.Builder.char ':' + <> Text.Builder.text (Path.absToText path) + UnqualifiedPath path -> + Path.toText' path data IncrementalBranchRelativePath - = -- | no dots, slashes, or colons - ProjectOrRelative Text Path.Path' - | -- | dots, no slashes or colons - LooseCode Path.Path' + = -- | no dots, slashes, or colons, so could be a project name or a single path segment + ProjectOrPath' Text Path.Path' + | -- | dots, no slashes or colons, must be a relative or absolute path + OnlyPath' Path.Path' | -- | valid project, no slash IncompleteProject ProjectName | -- | valid project/branch, slash, no colon IncompleteBranch (Maybe ProjectName) (Maybe ProjectBranchName) | -- | valid project/branch, with colon - IncompletePath (Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName) (Maybe Path.Relative) - | PathRelativeToCurrentBranch Path.Relative + IncompletePath (Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName) (Maybe Path.Absolute) + | PathRelativeToCurrentBranch Path.Absolute deriving stock (Show) -- | @@ -158,9 +144,9 @@ incrementalBranchRelativePathParser = pure (IncompleteProject projectName) in end <|> startingAtSlash (Just projectName) -- The string doesn't parse as a project name but does parse as a path - That (_, path) -> pure (LooseCode path) + That (_, path) -> pure (OnlyPath' path) -- The string parses both as a project name and a path - These _ (_, path) -> ProjectOrRelative <$> Megaparsec.takeRest <*> pure path + These _ (_, path) -> ProjectOrPath' <$> Megaparsec.takeRest <*> pure path startingAtBranch :: Maybe ProjectName -> Megaparsec.Parsec Void Text IncrementalBranchRelativePath startingAtBranch mproj = @@ -180,28 +166,30 @@ incrementalBranchRelativePathParser = Megaparsec.Parsec Void Text IncrementalBranchRelativePath startingAtColon projStuff = do _ <- Megaparsec.char ':' - p <- optionalEof relPath + p <- optionalEof brPath pure (IncompletePath projStuff p) pathRelativeToCurrentBranch :: Megaparsec.Parsec Void Text IncrementalBranchRelativePath pathRelativeToCurrentBranch = do _ <- Megaparsec.char ':' - p <- relPath + p <- brPath pure (PathRelativeToCurrentBranch p) optionalEof :: Megaparsec.Parsec Void Text a -> Megaparsec.Parsec Void Text (Maybe a) - optionalEof pa = Just <$> pa <|> Nothing <$ Megaparsec.eof + optionalEof pa = Just <$> pa <|> (Nothing <$ Megaparsec.eof) optionalBranch :: Megaparsec.Parsec Void Text (Maybe ProjectBranchName) optionalBranch = optionalEof branchNameParser branchNameParser = Project.projectBranchNameParser False - relPath = do + brPath :: Megaparsec.Parsec Void Text Path.Absolute + brPath = do offset <- Megaparsec.getOffset path' >>= \(Path.Path' inner) -> case inner of - Left _ -> failureAt offset "Expected a relative path but found an absolute path" - Right x -> pure x + Left _ -> failureAt offset "Branch qualified paths don't require a leading '.'" + -- Branch relative paths are written as relative paths, but are always absolute to the branch root + Right (Path.Relative x) -> pure $ Path.Absolute x path' = Megaparsec.try do offset <- Megaparsec.getOffset pathStr <- Megaparsec.takeRest @@ -234,16 +222,20 @@ incrementalBranchRelativePathParser = branchRelativePathParser :: Megaparsec.Parsec Void Text BranchRelativePath branchRelativePathParser = incrementalBranchRelativePathParser >>= \case - ProjectOrRelative _txt path -> pure (LoosePath path) - LooseCode path -> pure (LoosePath path) + ProjectOrPath' _txt path -> pure (UnqualifiedPath path) + OnlyPath' path -> pure (UnqualifiedPath path) IncompleteProject _proj -> fail "Branch relative paths require a branch. Expected `/` here." IncompleteBranch _mproj _mbranch -> fail "Branch relative paths require a colon. Expected `:` here." - PathRelativeToCurrentBranch p -> pure (BranchRelative (That p)) + PathRelativeToCurrentBranch p -> pure (UnqualifiedPath (Path.AbsolutePath' p)) IncompletePath projStuff mpath -> case projStuff of - Left (ProjectAndBranch projName branchName) -> case mpath of - Nothing -> pure (BranchRelative (This (Right (projName, branchName)))) - Just path -> pure (BranchRelative (These (Right (projName, branchName)) path)) - Right branch -> case mpath of - Nothing -> pure (BranchRelative (This (Left branch))) - Just path -> pure (BranchRelative (These (Left branch) path)) + Left (ProjectAndBranch projName branchName) -> + pure $ QualifiedBranchPath projName branchName (fromMaybe Path.absoluteEmpty mpath) + Right branch -> + pure $ BranchPathInCurrentProject branch (fromMaybe Path.absoluteEmpty mpath) + +toText :: BranchRelativePath -> Text +toText = \case + BranchPathInCurrentProject pbName path -> ProjectPath () pbName path & into @Text + QualifiedBranchPath projName pbName path -> ProjectPath projName pbName path & into @Text + UnqualifiedPath path' -> Path.toText' path' diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index 28822ea6f8..10a838373e 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -20,9 +20,8 @@ module Unison.CommandLine.Completion ) where -import Control.Lens (ifoldMap) +import Control.Lens import Control.Lens qualified as Lens -import Control.Lens.Cons (unsnoc) import Data.Aeson qualified as Aeson import Data.List (isPrefixOf) import Data.List qualified as List @@ -48,9 +47,10 @@ import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.CommandLine.InputPattern qualified as IP -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name qualified as Name import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude @@ -73,9 +73,9 @@ haskelineTabComplete :: Map String IP.InputPattern -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> Line.CompletionFunc m -haskelineTabComplete patterns codebase authedHTTPClient currentPath = Line.completeWordWithPrev Nothing " " $ \prev word -> +haskelineTabComplete patterns codebase authedHTTPClient ppCtx = Line.completeWordWithPrev Nothing " " $ \prev word -> -- User hasn't finished a command name, complete from command names if null prev then pure . exactComplete word $ Map.keys patterns @@ -84,7 +84,7 @@ haskelineTabComplete patterns codebase authedHTTPClient currentPath = Line.compl h : t -> fromMaybe (pure []) $ do p <- Map.lookup h patterns argType <- IP.argType p (length t) - pure $ IP.suggestions argType word codebase authedHTTPClient currentPath + pure $ IP.suggestions argType word codebase authedHTTPClient ppCtx _ -> pure [] -- | Things which we may want to complete for. @@ -101,7 +101,7 @@ noCompletions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [System.Console.Haskeline.Completion.Completion] noCompletions _ _ _ _ = pure [] @@ -141,11 +141,11 @@ completeWithinNamespace :: NESet CompletionType -> -- | The portion of this are that the user has already typed. String -> - Path.Absolute -> + PP.ProjectPath -> Sqlite.Transaction [System.Console.Haskeline.Completion.Completion] -completeWithinNamespace compTypes query currentPath = do +completeWithinNamespace compTypes query ppCtx = do shortHashLen <- Codebase.hashLength - b <- Codebase.getShallowBranchAtPath (Path.unabsolute absQueryPath) Nothing + b <- Codebase.getShallowBranchAtProjectPath queryProjectPath currentBranchSuggestions <- do nib <- namesInBranch shortHashLen b nib @@ -168,8 +168,8 @@ completeWithinNamespace compTypes query currentPath = do queryPathPrefix :: Path.Path' querySuffix :: Text (queryPathPrefix, querySuffix) = parseLaxPath'Query (Text.pack query) - absQueryPath :: Path.Absolute - absQueryPath = Path.resolve currentPath queryPathPrefix + queryProjectPath :: PP.ProjectPath + queryProjectPath = ppCtx & PP.absPath_ %~ \curPath -> Path.resolve curPath queryPathPrefix getChildSuggestions :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [Completion] getChildSuggestions shortHashLen b | Text.null querySuffix = pure [] @@ -196,12 +196,6 @@ completeWithinNamespace compTypes query currentPath = do namesInBranch :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [(CompletionType, Bool, Text)] namesInBranch hashLen b = do nonEmptyChildren <- V2Branch.nonEmptyChildren b - let textifyHQ :: (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [(Bool, Text)] - textifyHQ f xs = - xs - & hashQualifyCompletions f - & fmap (HQ'.toTextWith NameSegment.toEscapedText) - & fmap (True,) pure $ concat [ (NamespaceCompletion,False,) <$> (fmap NameSegment.toEscapedText . Map.keys $ nonEmptyChildren), @@ -216,6 +210,12 @@ completeWithinNamespace compTypes query currentPath = do (fmap ((PatchCompletion,True,) . NameSegment.toEscapedText) . Map.keys $ V2Branch.patches b) ] + textifyHQ :: (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [(Bool, Text)] + textifyHQ f xs = + xs + & hashQualifyCompletions f + & fmap (HQ'.toTextWith NameSegment.toEscapedText) + & fmap (True,) -- Regrettably there'shqFromNamedV2Referencenot a great spot to combinators for V2 references and shorthashes right now. hqFromNamedV2Referent :: Int -> NameSegment -> Referent.Referent -> HQ'.HashQualified NameSegment hqFromNamedV2Referent hashLen n r = HQ'.HashQualified n (Cv.referent2toshorthash1 (Just hashLen) r) @@ -274,35 +274,35 @@ parseLaxPath'Query txt = -- | Completes a namespace argument by prefix-matching against the query. prefixCompleteNamespace :: String -> - Path.Absolute -> -- Current path + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteNamespace = completeWithinNamespace (NESet.singleton NamespaceCompletion) -- | Completes a term or type argument by prefix-matching against the query. prefixCompleteTermOrType :: String -> - Path.Absolute -> -- Current path + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteTermOrType = completeWithinNamespace (NESet.fromList (TermCompletion NE.:| [TypeCompletion])) -- | Completes a term argument by prefix-matching against the query. prefixCompleteTerm :: String -> - Path.Absolute -> -- Current path + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteTerm = completeWithinNamespace (NESet.singleton TermCompletion) -- | Completes a term or type argument by prefix-matching against the query. prefixCompleteType :: String -> - Path.Absolute -> -- Current path + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteType = completeWithinNamespace (NESet.singleton TypeCompletion) -- | Completes a patch argument by prefix-matching against the query. prefixCompletePatch :: String -> - Path.Absolute -> -- Current path + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompletePatch = completeWithinNamespace (NESet.singleton PatchCompletion) diff --git a/unison-cli/src/Unison/CommandLine/DisplayValues.hs b/unison-cli/src/Unison/CommandLine/DisplayValues.hs index b7b7d3bf65..6bfb43957d 100644 --- a/unison-cli/src/Unison/CommandLine/DisplayValues.hs +++ b/unison-cli/src/Unison/CommandLine/DisplayValues.hs @@ -178,12 +178,12 @@ displayPretty pped terms typeOf eval types tm = go tm DD.Doc2SpecialFormExample n (DD.Doc2Example vs body) -> P.backticked <$> displayTerm pped terms typeOf eval types ex where - ex = Term.lam' (ABT.annotation body) (drop (fromIntegral n) vs) body + ex = Term.lamWithoutBindingAnns (ABT.annotation body) (drop (fromIntegral n) vs) body DD.Doc2SpecialFormExampleBlock n (DD.Doc2Example vs body) -> -- todo: maybe do something with `vs` to indicate the variables are free P.indentN 4 <$> displayTerm' True pped terms typeOf eval types ex where - ex = Term.lam' (ABT.annotation body) (drop (fromIntegral n) vs) body + ex = Term.lamWithoutBindingAnns (ABT.annotation body) (drop (fromIntegral n) vs) body -- Link (Either Link.Type Doc2.Term) DD.Doc2SpecialFormLink e -> diff --git a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs index a6f23f2dbf..37fdff8b18 100644 --- a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs +++ b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs @@ -37,13 +37,13 @@ import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Position qualified as Position import Unison.Prelude -import Unison.Project.Util (ProjectContext (..)) import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Syntax.NameSegment qualified as NameSegment @@ -51,7 +51,7 @@ import Unison.Util.Monoid (foldMapM) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Relation qualified as Relation -type OptionFetcher = Codebase IO Symbol Ann -> ProjectContext -> Branch0 IO -> IO [Text] +type OptionFetcher = Codebase IO Symbol Ann -> PP.ProjectPath -> Branch0 IO -> IO [Text] data FZFResolver = FZFResolver { getOptions :: OptionFetcher @@ -121,7 +121,7 @@ fuzzySelectFromList options = -- | Combine multiple option fetchers into one resolver. multiResolver :: [OptionFetcher] -> FZFResolver multiResolver resolvers = - let getOptions :: Codebase IO Symbol Ann -> ProjectContext -> Branch0 IO -> IO [Text] + let getOptions :: Codebase IO Symbol Ann -> PP.ProjectPath -> Branch0 IO -> IO [Text] getOptions codebase projCtx searchBranch0 = do List.nubOrd <$> foldMapM (\f -> f codebase projCtx searchBranch0) resolvers in (FZFResolver {getOptions}) @@ -177,11 +177,8 @@ projectBranchOptions codebase _projCtx _searchBranch0 = do -- E.g. '@unison/base/main' projectBranchOptionsWithinCurrentProject :: OptionFetcher projectBranchOptionsWithinCurrentProject codebase projCtx _searchBranch0 = do - case projCtx of - LooseCodePath _ -> pure [] - ProjectBranchPath currentProjectId _projectBranchId _path -> do - Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith currentProjectId Nothing) - <&> fmap (into @Text . snd) + Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. #project . #projectId) Nothing) + <&> fmap (into @Text . snd) -- | Exported from here just so the debug command and actual implementation can use the same -- messaging. diff --git a/unison-cli/src/Unison/CommandLine/Helpers.hs b/unison-cli/src/Unison/CommandLine/Helpers.hs new file mode 100644 index 0000000000..d50258e304 --- /dev/null +++ b/unison-cli/src/Unison/CommandLine/Helpers.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} + +module Unison.CommandLine.Helpers + ( -- * Pretty Printing + backtick, + aside, + bigproblem, + note, + nothingTodo, + plural, + plural', + problem, + tip, + warn, + warnNote, + ) +where + +import Data.ListLike (ListLike) +import Unison.Prelude +import Unison.Util.Pretty qualified as P +import Prelude hiding (readFile, writeFile) + +warnNote :: String -> String +warnNote s = "⚠️ " <> s + +backtick :: (IsString s) => P.Pretty s -> P.Pretty s +backtick s = P.group ("`" <> s <> "`") + +tip :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +tip s = P.column2 [("Tip:", P.wrap s)] + +note :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +note s = P.column2 [("Note:", P.wrap s)] + +aside :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -> P.Pretty s +aside a b = P.column2 [(a <> ":", b)] + +warn :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +warn = emojiNote "⚠️" + +problem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +problem = emojiNote "❗️" + +bigproblem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +bigproblem = emojiNote "‼️" + +emojiNote :: (ListLike s Char, IsString s) => String -> P.Pretty s -> P.Pretty s +emojiNote lead s = P.group (fromString lead) <> "\n" <> P.wrap s + +nothingTodo :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +nothingTodo = emojiNote "😶" + +-- `plural [] "cat" "cats" = "cats"` +-- `plural ["meow"] "cat" "cats" = "cat"` +-- `plural ["meow", "meow"] "cat" "cats" = "cats"` +plural :: (Foldable f) => f a -> b -> b -> b +plural items one other = case toList items of + [_] -> one + _ -> other + +plural' :: (Integral a) => a -> b -> b -> b +plural' 1 one _other = one +plural' _ _one other = other diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index 4014bc1dc7..cc628559e6 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -28,7 +28,7 @@ import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) import Unison.Codebase.Editor.Input (Input (..)) import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) -import Unison.Codebase.Path as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.FZFResolvers (FZFResolver (..)) import Unison.Prelude import Unison.Util.ColorText qualified as CT @@ -66,7 +66,16 @@ data InputPattern = InputPattern visibility :: Visibility, -- Allow hiding certain commands when debugging or work-in-progress args :: [(ArgumentDescription, IsOptional, ArgumentType)], help :: P.Pretty CT.ColorText, - parse :: Arguments -> Either (P.Pretty CT.ColorText) Input + -- | Parse the arguments and return either an error message or a command `Input`. + -- + -- __NB__: This function should return `Left` only on failure. For commands (like `help`) that simply produce + -- formatted output, use `pure . Input.CreateMessage`. The failure output should be fully formatted (using + -- `wrap`, etc.), but shouldn’t include any general error components like a warninng flag or the full help + -- message, and shouldn’t plan for the context it is being output to (e.g., don’t `P.indentN` the entire + -- message). + parse :: + Arguments -> + Either (P.Pretty CT.ColorText) Input } data ArgumentType = ArgumentType @@ -78,7 +87,7 @@ data ArgumentType = ArgumentType String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> -- Current path + PP.ProjectPath -> m [Line.Completion], -- | If an argument is marked as required, but not provided, the fuzzy finder will be triggered if -- available. @@ -157,14 +166,14 @@ unionSuggestions :: [ ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) ] -> ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) unionSuggestions suggesters inp codebase httpClient path = do @@ -179,14 +188,14 @@ suggestionFallbacks :: [ ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) ] -> ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) suggestionFallbacks suggesters inp codebase httpClient path = go suggesters diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 54b65279d2..6dc5581f62 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1,7 +1,4 @@ -{- - This module defines 'InputPattern' values for every supported input command. --} - +-- | This module defines 'InputPattern' values for every supported input command. module Unison.CommandLine.InputPatterns ( -- * Input commands add, @@ -31,6 +28,7 @@ module Unison.CommandLine.InputPatterns debugNameDiff, debugNumberedArgs, debugTabCompletion, + debugLspNameCompletion, debugTerm, debugTermVerbose, debugType, @@ -102,7 +100,6 @@ module Unison.CommandLine.InputPatterns renameTerm, renameType, reset, - resetRoot, runScheme, saveExecuteResult, sfind, @@ -121,7 +118,10 @@ module Unison.CommandLine.InputPatterns upgradeCommitInputPattern, view, viewGlobal, - viewReflog, + deprecatedViewRootReflog, + branchReflog, + projectReflog, + globalReflog, -- * Misc formatStructuredArgument, @@ -138,7 +138,6 @@ module Unison.CommandLine.InputPatterns ) where -import Control.Lens (preview, review) import Control.Lens.Cons qualified as Cons import Data.Bitraversable (bitraverse) import Data.List (intercalate) @@ -154,6 +153,8 @@ import System.Console.Haskeline.Completion (Completion (Completion)) import System.Console.Haskeline.Completion qualified as Haskeline import System.Console.Haskeline.Completion qualified as Line import Text.Megaparsec qualified as Megaparsec +import Text.Numeral (defaultInflection) +import Text.Numeral.Language.ENG qualified as Numeral import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Sqlite.DbId (ProjectBranchId) import U.Codebase.Sqlite.Project qualified as Sqlite @@ -168,14 +169,13 @@ import Unison.Cli.Pretty prettySlashProjectBranchName, prettyURI, ) -import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Merge qualified as Branch -import Unison.Codebase.Editor.Input (DeleteOutput (..), DeleteTarget (..), Input) +import Unison.Codebase.Editor.Input (BranchIdG (..), DeleteOutput (..), DeleteTarget (..), Input) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push)) -import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteRemoteNamespace) +import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace) import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.SlurpResult qualified as SR import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) @@ -185,19 +185,21 @@ import Unison.Codebase.Editor.UriParser qualified as UriParser import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH -import Unison.CommandLine import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..), parseBranchRelativePath, parseIncrementalBranchRelativePath) import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath import Unison.CommandLine.Completion import Unison.CommandLine.FZFResolvers qualified as Resolvers +import Unison.CommandLine.Helpers (aside, backtick, tip) import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPattern), IsOptional (..), unionSuggestions) import Unison.CommandLine.InputPattern qualified as I import Unison.Core.Project (ProjectBranchName (..)) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -213,7 +215,6 @@ import Unison.Project Semver, branchWithOptionalProjectParser, ) -import Unison.Project.Util (ProjectContext (..), projectContextFromPath) import Unison.Referent qualified as Referent import Unison.Server.Backend (ShallowListEntry (..)) import Unison.Server.Backend qualified as Backend @@ -249,8 +250,14 @@ formatStructuredArgument schLength = \case -- prefixBranchId ".base" "List.map" -> ".base.List.map" prefixBranchId :: Input.AbsBranchId -> Name -> Text prefixBranchId branchId name = case branchId of - Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) - Right pathPrefix -> Name.toText (Path.prefixNameIfRel (Path.AbsolutePath' pathPrefix) name) + BranchAtSCH sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) + BranchAtPath pathPrefix -> Name.toText (Path.prefixNameIfRel (Path.AbsolutePath' pathPrefix) name) + BranchAtProjectPath pp -> + pp + & PP.absPath_ + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + & PP.toNames + & into @Text entryToHQText :: Path' -> ShallowListEntry v Ann -> Text entryToHQText pathArg = @@ -302,18 +309,26 @@ searchResultToHQ oprefix = \case addPrefix :: Name -> Name addPrefix = maybe id Path.prefixNameIfRel oprefix -unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.ColorText) String -unsupportedStructuredArgument expected = - either pure (const . Left . P.text $ "can’t use a numbered argument for " <> expected) +unsupportedStructuredArgument :: InputPattern -> Text -> I.Argument -> Either (P.Pretty CT.ColorText) String +unsupportedStructuredArgument command expected = + either pure . const . Left . P.wrap $ + makeExample' command + <> "can’t accept a numbered argument for" + <> P.text expected + <> "and it’s not yet possible to provide un-expanded numbers as arguments." + +expectedButActually' :: Text -> String -> P.Pretty CT.ColorText +expectedButActually' expected actualValue = + P.text $ "I expected " <> expected <> ", but couldn’t recognize “" <> Text.pack actualValue <> "” as one." expectedButActually :: Text -> StructuredArgument -> Text -> P.Pretty CT.ColorText expectedButActually expected actualValue actualType = P.text $ - "Expected " + "I expected " <> expected - <> ", but the numbered arg resulted in " + <> ", but the numbered argument resulted in “" <> formatStructuredArgument Nothing actualValue - <> ", which is " + <> "”, which is " <> actualType <> "." @@ -334,6 +349,14 @@ wrongStructuredArgument expected actual = SA.ShallowListEntry _ _ -> "a name" SA.SearchResult _ _ -> "a search result" +wrongArgsLength :: Text -> [a] -> Either (P.Pretty CT.ColorText) b +wrongArgsLength expected args = + let foundCount = + case length args of + 0 -> "none" + n -> fromMaybe (tShow n) $ Numeral.us_cardinal defaultInflection n + in Left . P.text $ "I expected " <> expected <> ", but received " <> foundCount <> "." + patternName :: InputPattern -> P.Pretty P.ColorText patternName = fromString . I.patternName @@ -357,23 +380,11 @@ helpFor = I.help handleProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectName handleProjectArg = either - ( \name -> - first (const . P.text $ "“" <> Text.pack name <> "” is an invalid project name") . tryInto @ProjectName $ - Text.pack name - ) + (\name -> first (const $ expectedButActually' "a project" name) . tryInto @ProjectName $ Text.pack name) \case SA.Project project -> pure project otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType -handleLooseCodeOrProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.LooseCodeOrProject -handleLooseCodeOrProjectArg = - either - (maybe (Left $ P.text "invalid path or project branch") pure . parseLooseCodeOrProject) - \case - SA.AbsolutePath path -> pure . This $ Path.absoluteToPath' path - SA.ProjectBranch pb -> pure $ That pb - otherArgType -> Left $ wrongStructuredArgument "a path or project branch" otherArgType - handleMaybeProjectBranchArg :: I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) handleMaybeProjectBranchArg = @@ -387,12 +398,12 @@ handleProjectMaybeBranchArg :: I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) handleProjectMaybeBranchArg = either - (first (const $ P.text "The argument wasn’t a project") . tryInto . Text.pack) + (\str -> first (const $ expectedButActually' "a project or branch" str) . tryInto $ Text.pack str) \case SA.Project proj -> pure $ ProjectAndBranch proj Nothing SA.ProjectBranch (ProjectAndBranch (Just proj) branch) -> pure . ProjectAndBranch proj . pure $ ProjectBranchNameOrLatestRelease'Name branch - otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType + otherArgType -> Left $ wrongStructuredArgument "a project or branch" otherArgType handleHashQualifiedNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name) handleHashQualifiedNameArg = @@ -468,8 +479,8 @@ handleSplit'Arg = (first P.text . Path.parseSplit') \case SA.Name name -> pure $ Path.splitFromName' name - SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name - SA.NameWithBranchPrefix (Right prefix) name -> + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure $ Path.splitFromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> pure . Path.splitFromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg @@ -486,27 +497,35 @@ handleBranchIdArg = either (first P.text . Input.parseBranchId) \case - SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path - SA.Name name -> pure . pure $ Path.fromName' name + SA.AbsolutePath path -> pure . BranchAtPath $ Path.absoluteToPath' path + SA.Name name -> pure . BranchAtPath $ Path.fromName' name SA.NameWithBranchPrefix mprefix name -> - pure . pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix - SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash + pure $ case mprefix of + BranchAtSCH _sch -> BranchAtPath . Path.fromName' $ name + BranchAtPath prefix -> BranchAtPath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + BranchAtProjectPath pp -> + pp + & PP.absPath_ + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + & BranchAtProjectPath + SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg -handleBranchIdOrProjectArg :: +-- | TODO: Maybe remove? +_handleBranchIdOrProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) (These Input.BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) -handleBranchIdOrProjectArg = +_handleBranchIdOrProjectArg = either - (maybe (Left $ P.text "Expected a branch or project, but it’s not") pure . branchIdOrProject) + (\str -> maybe (Left $ expectedButActually' "a branch" str) pure $ branchIdOrProject str) \case - SA.Namespace hash -> pure . This . Left $ SCH.fromFullHash hash - SA.AbsolutePath path -> pure . This . pure $ Path.absoluteToPath' path - SA.Name name -> pure . This . pure $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . This . pure . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name - SA.ProjectBranch pb -> pure $ pure pb + SA.Namespace hash -> pure . This . BranchAtSCH $ SCH.fromFullHash hash + SA.AbsolutePath path -> pure . This . BranchAtPath $ Path.absoluteToPath' path + SA.Name name -> pure . This . BranchAtPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure . This . BranchAtPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> + pure . This . BranchAtPath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.ProjectBranch pb -> pure $ That pb otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType where branchIdOrProject :: @@ -527,19 +546,21 @@ handleBranchIdOrProjectArg = (Right bid, Left _) -> Just (This bid) (Right bid, Right pr) -> Just (These bid pr) -handleBranchId2Arg :: I.Argument -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) +handleBranchId2Arg :: I.Argument -> Either (P.Pretty P.ColorText) Input.BranchId2 handleBranchId2Arg = either Input.parseBranchId2 \case SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash - SA.AbsolutePath path -> pure . pure . LoosePath $ Path.absoluteToPath' path - SA.Name name -> pure . pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.AbsolutePath path -> pure . pure . UnqualifiedPath $ Path.absoluteToPath' path + SA.Name name -> pure . pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure . pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> + pure . pure . UnqualifiedPath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.ProjectBranch (ProjectAndBranch mproject branch) -> - pure . pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject + case mproject of + Just proj -> pure . pure $ QualifiedBranchPath proj branch Path.absoluteEmpty + Nothing -> pure . pure $ BranchPathInCurrentProject branch Path.absoluteEmpty otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg handleBranchRelativePathArg :: I.Argument -> Either (P.Pretty P.ColorText) BranchRelativePath @@ -547,13 +568,15 @@ handleBranchRelativePathArg = either parseBranchRelativePath \case - SA.AbsolutePath path -> pure . LoosePath $ Path.absoluteToPath' path - SA.Name name -> pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.AbsolutePath path -> pure . UnqualifiedPath $ Path.absoluteToPath' path + SA.Name name -> pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> + pure . UnqualifiedPath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.ProjectBranch (ProjectAndBranch mproject branch) -> - pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject + case mproject of + Just proj -> pure $ QualifiedBranchPath proj branch Path.absoluteEmpty + Nothing -> pure $ BranchPathInCurrentProject branch Path.absoluteEmpty otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg hqNameToSplit' :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit' @@ -585,8 +608,8 @@ handleHashQualifiedSplit'Arg = \case SA.Name name -> pure $ Path.hqSplitFromName' name hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . hq'NameToSplit' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname SA.ShallowListEntry prefix entry -> pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry @@ -608,8 +631,8 @@ handleHashQualifiedSplitArg = pure $ Path.hqSplitFromName' name hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure $ hq'NameToSplit hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . hq'NameToSplit $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname SA.ShallowListEntry _ entry -> pure . hq'NameToSplit $ shallowListEntryToHQ' entry sr@(SA.SearchResult mpath result) -> @@ -631,8 +654,8 @@ handleShortHashOrHQSplit'Arg = (first P.text . Path.parseShortHashOrHQSplit') \case SA.HashQualified name -> pure $ hqNameToSplit' name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure . pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . pure $ hq'NameToSplit' (Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname) SA.ShallowListEntry prefix entry -> pure . pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry @@ -653,11 +676,11 @@ handleNameArg = (first P.text . Name.parseTextEither . Text.pack) \case SA.Name name -> pure name - SA.NameWithBranchPrefix (Left _) name -> pure name - SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname SA.ShallowListEntry prefix entry -> pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry @@ -681,25 +704,20 @@ handlePullSourceArg = otherNumArg -> Left $ wrongStructuredArgument "a source to pull from" otherNumArg handlePushTargetArg :: - I.Argument -> Either (P.Pretty CT.ColorText) (WriteRemoteNamespace (These ProjectName ProjectBranchName)) + I.Argument -> Either (P.Pretty CT.ColorText) (These ProjectName ProjectBranchName) handlePushTargetArg = either - (maybe (Left "Wanted a source to push from, but this ain’t it.") pure . parsePushTarget) - $ fmap RemoteRepo.WriteRemoteProjectBranch . \case + (\str -> maybe (Left $ expectedButActually' "a target to push to" str) pure $ parsePushTarget str) + $ \case SA.Project project -> pure $ This project SA.ProjectBranch (ProjectAndBranch project branch) -> pure $ maybe That These project branch - otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg + otherNumArg -> Left $ wrongStructuredArgument "a target to push to" otherNumArg handlePushSourceArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.PushSource handlePushSourceArg = either - (maybe (Left $ P.text "Wanted a source to push from, but this ain’t it.") pure . parsePushSource) + (\str -> maybe (Left $ expectedButActually' "a source to push from" str) pure $ parsePushSource str) \case - SA.AbsolutePath path -> pure . Input.PathySource $ Path.absoluteToPath' path - SA.Name name -> pure . Input.PathySource $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . Input.PathySource $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . Input.PathySource . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.Project project -> pure . Input.ProjySource $ This project SA.ProjectBranch (ProjectAndBranch project branch) -> pure . Input.ProjySource $ maybe That These project branch otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg @@ -707,7 +725,7 @@ handlePushSourceArg = handleProjectAndBranchNamesArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectAndBranchNames handleProjectAndBranchNamesArg = either - (first (const $ P.text "The argument wasn’t a project or branch") . tryInto @ProjectAndBranchNames . Text.pack) + (\str -> first (const $ expectedButActually' "a project or branch" str) . tryInto @ProjectAndBranchNames $ Text.pack str) $ fmap ProjectAndBranchNames'Unambiguous . \case SA.Project project -> pure $ This project SA.ProjectBranch (ProjectAndBranch mproj branch) -> pure $ maybe That These mproj branch @@ -724,7 +742,7 @@ mergeBuiltins = \case [] -> pure . Input.MergeBuiltinsI $ Nothing [p] -> Input.MergeBuiltinsI . Just <$> handlePathArg p - _ -> Left (I.help mergeBuiltins) + args -> wrongArgsLength "no more than one argument" args mergeIOBuiltins :: InputPattern mergeIOBuiltins = @@ -737,7 +755,7 @@ mergeIOBuiltins = \case [] -> pure . Input.MergeIOBuiltinsI $ Nothing [p] -> Input.MergeIOBuiltinsI . Just <$> handlePathArg p - _ -> Left (I.help mergeBuiltins) + args -> wrongArgsLength "no more than one argument" args updateBuiltins :: InputPattern updateBuiltins = @@ -757,30 +775,15 @@ todo = "todo" [] I.Visible - [("patch", Optional, patchArg), ("namespace", Optional, namespaceArg)] - ( P.wrapColumn2 - [ ( makeExample' todo, - "lists the refactor work remaining in the default patch for the current" - <> " namespace." - ), - ( makeExample todo [""], - "lists the refactor work remaining in the given patch in the current " - <> "namespace." - ), - ( makeExample todo ["", "[path]"], - "lists the refactor work remaining in the given patch in given namespace." - ) - ] + [] + ( P.wrap $ + makeExample' todo + <> "lists the current namespace's outstanding issues, including conflicted names, dependencies with missing" + <> "names, and merge precondition violations." ) \case - patchStr : ws -> first warn $ do - patch <- handleSplit'Arg patchStr - branch <- case ws of - [] -> pure Path.relativeEmpty' - [pathStr] -> handlePath'Arg pathStr - _ -> Left "`todo` just takes a patch and one optional namespace" - Right $ Input.TodoI (Just patch) branch - [] -> Right $ Input.TodoI Nothing Path.relativeEmpty' + [] -> Right Input.TodoI + args -> wrongArgsLength "no arguments" args load :: InputPattern load = @@ -800,8 +803,8 @@ load = ) \case [] -> pure $ Input.LoadI Nothing - [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument "a file name" file - _ -> Left (I.help load) + [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument load "a file name" file + args -> wrongArgsLength "no more than one argument" args clear :: InputPattern clear = @@ -818,7 +821,7 @@ clear = ) \case [] -> pure Input.ClearI - _ -> Left (I.help clear) + args -> wrongArgsLength "no arguments" args add :: InputPattern add = @@ -861,7 +864,7 @@ update = <> "for your review.", parse = \case [] -> pure Input.Update2I - _ -> Left $ I.help update + args -> wrongArgsLength "no arguments" args } updateOldNoPatch :: InputPattern @@ -962,7 +965,7 @@ view = ] ) ( maybe - (Left $ I.help view) + (wrongArgsLength "at least one argument" []) ( fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionLocal) . traverse handleHashQualifiedNameArg ) @@ -982,7 +985,7 @@ viewGlobal = ] ) ( maybe - (Left $ I.help viewGlobal) + (wrongArgsLength "at least one argument" []) ( fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionGlobal) . traverse handleHashQualifiedNameArg ) @@ -1001,7 +1004,9 @@ display = "`display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH." ] ) - $ maybe (Left $ I.help display) (fmap (Input.DisplayI Input.ConsoleLocation) . traverse handleHashQualifiedNameArg) + $ maybe + (wrongArgsLength "at least one argument" []) + (fmap (Input.DisplayI Input.ConsoleLocation) . traverse handleHashQualifiedNameArg) . NE.nonEmpty displayTo :: InputPattern @@ -1018,14 +1023,14 @@ displayTo = $ \case file : defs -> maybe - (Left $ I.help displayTo) + (wrongArgsLength "at least two arguments" [file]) ( \defs -> Input.DisplayI . Input.FileLocation - <$> unsupportedStructuredArgument "a file name" file + <$> unsupportedStructuredArgument displayTo "a file name" file <*> traverse handleHashQualifiedNameArg defs ) $ NE.nonEmpty defs - _ -> Left (I.help displayTo) + [] -> wrongArgsLength "at least two arguments" [] docs :: InputPattern docs = @@ -1039,7 +1044,7 @@ docs = "`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH." ] ) - $ maybe (Left $ I.help docs) (fmap Input.DocsI . traverse handleNameArg) . NE.nonEmpty + $ maybe (wrongArgsLength "at least one argument" []) (fmap Input.DocsI . traverse handleNameArg) . NE.nonEmpty api :: InputPattern api = @@ -1062,7 +1067,7 @@ ui = parse = \case [] -> pure $ Input.UiI Path.relativeEmpty' [path] -> Input.UiI <$> handlePath'Arg path - _ -> Left (I.help ui) + args -> wrongArgsLength "no more than one argument" args } undo :: InputPattern @@ -1079,10 +1084,9 @@ sfind :: InputPattern sfind = InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse where - parse [q] = - Input.StructuredFindI (Input.FindLocal Path.relativeEmpty') - <$> handleHashQualifiedNameArg q - parse _ = Left "expected exactly one argument" + parse = \case + [q] -> Input.StructuredFindI (Input.FindLocal Path.relativeEmpty') <$> handleHashQualifiedNameArg q + args -> wrongArgsLength "exactly one argument" args msg = P.lines [ P.wrap $ @@ -1113,7 +1117,7 @@ sfindReplace = InputPattern "rewrite" ["sfind.replace"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse where parse [q] = Input.StructuredFindReplaceI <$> handleHashQualifiedNameArg q - parse _ = Left "expected exactly one argument" + parse args = wrongArgsLength "exactly one argument" args msg :: P.Pretty CT.ColorText msg = P.lines @@ -1161,7 +1165,7 @@ findIn' cmd mkfscope = findHelp \case p : args -> Input.FindI False . mkfscope <$> handlePath'Arg p <*> pure (unifyArgument <$> args) - _ -> Left findHelp + args -> wrongArgsLength "at least one argument" args findHelp :: P.Pretty CT.ColorText findHelp = @@ -1225,7 +1229,7 @@ findShallow = ( fmap Input.FindShallowI . \case [] -> pure Path.relativeEmpty' [path] -> handlePath'Arg path - _ -> Left (I.help findShallow) + args -> wrongArgsLength "no more than one argument" args ) findVerbose :: InputPattern @@ -1264,7 +1268,7 @@ renameTerm = "`move.term foo bar` renames `foo` to `bar`." \case [oldName, newName] -> Input.MoveTermI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName - _ -> Left . P.warnCallout $ P.wrap "`rename.term` takes two arguments, like `rename.term oldname newname`." + _ -> Left $ P.wrap "`rename.term` takes two arguments, like `rename.term oldname newname`." moveAll :: InputPattern moveAll = @@ -1278,7 +1282,7 @@ moveAll = "`move foo bar` renames the term, type, and namespace foo to bar." \case [oldName, newName] -> Input.MoveAllI <$> handlePath'Arg oldName <*> handleNewPath newName - _ -> Left . P.warnCallout $ P.wrap "`move` takes two arguments, like `move oldname newname`." + _ -> Left $ P.wrap "`move` takes two arguments, like `move oldname newname`." renameType :: InputPattern renameType = @@ -1293,7 +1297,7 @@ renameType = \case [oldName, newName] -> Input.MoveTypeI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName _ -> - Left . P.warnCallout $ P.wrap "`rename.type` takes two arguments, like `rename.type oldname newname`." + Left $ P.wrap "`rename.type` takes two arguments, like `rename.type oldname newname`." deleteGen :: Maybe String -> ArgumentType -> String -> ([Path.HQSplit'] -> DeleteTarget) -> InputPattern deleteGen suffix queryCompletionArg target mkTarget = @@ -1319,7 +1323,7 @@ deleteGen suffix queryCompletionArg target mkTarget = "" ) ] - warn = + warning = P.sep " " [ backtick (P.string cmd), @@ -1333,7 +1337,7 @@ deleteGen suffix queryCompletionArg target mkTarget = [("definition to delete", OnePlus, queryCompletionArg)] info \case - [] -> Left . P.warnCallout $ P.wrap warn + [] -> Left $ P.wrap warning queries -> Input.DeleteI . mkTarget <$> traverse handleHashQualifiedSplit'Arg queries delete :: InputPattern @@ -1367,7 +1371,7 @@ deleteProject = ], parse = \case [name] -> Input.DeleteI . DeleteTarget'Project <$> handleProjectArg name - _ -> Left (showPatternHelp deleteProject) + args -> wrongArgsLength "exactly one argument" args } deleteBranch :: InputPattern @@ -1384,7 +1388,7 @@ deleteBranch = ], parse = \case [name] -> Input.DeleteI . DeleteTarget'ProjectBranch <$> handleMaybeProjectBranchArg name - _ -> Left (showPatternHelp deleteBranch) + args -> wrongArgsLength "exactly one argument" args } where suggestionsConfig = @@ -1397,14 +1401,30 @@ deleteBranch = aliasTerm :: InputPattern aliasTerm = InputPattern - "alias.term" - [] - I.Visible - [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)] - "`alias.term foo bar` introduces `bar` with the same definition as `foo`." - $ \case - [oldName, newName] -> Input.AliasTermI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName - _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." + { patternName = "alias.term", + aliases = [], + visibility = I.Visible, + args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)], + help = "`alias.term foo bar` introduces `bar` with the same definition as `foo`.", + parse = \case + [oldName, newName] -> Input.AliasTermI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> Left $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." + } + +debugAliasTermForce :: InputPattern +debugAliasTermForce = + InputPattern + { patternName = "debug.alias.term.force", + aliases = [], + visibility = I.Hidden, + args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)], + help = "`debug.alias.term.force foo bar` introduces `bar` with the same definition as `foo`.", + parse = \case + [oldName, newName] -> Input.AliasTermI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> + Left $ + P.wrap "`debug.alias.term.force` takes two arguments, like `debug.alias.term.force oldname newname`." + } aliasType :: InputPattern aliasType = @@ -1415,8 +1435,23 @@ aliasType = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)] "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." \case - [oldName, newName] -> Input.AliasTypeI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName - _ -> Left . warn $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." + [oldName, newName] -> Input.AliasTypeI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> Left $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." + +debugAliasTypeForce :: InputPattern +debugAliasTypeForce = + InputPattern + { patternName = "debug.alias.type.force", + aliases = [], + visibility = I.Hidden, + args = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)], + help = "`debug.alias.type.force Foo Bar` introduces `Bar` with the same definition as `Foo`.", + parse = \case + [oldName, newName] -> Input.AliasTypeI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> + Left $ + P.wrap "`debug.alias.type.force` takes two arguments, like `debug.alias.type.force oldname newname`." + } aliasMany :: InputPattern aliasMany = @@ -1437,7 +1472,7 @@ aliasMany = \case srcs@(_ : _) Cons.:> dest -> Input.AliasManyI <$> traverse handleHashQualifiedSplitArg srcs <*> handlePath'Arg dest - _ -> Left (I.help aliasMany) + args -> wrongArgsLength "at least two arguments" args up :: InputPattern up = @@ -1449,7 +1484,7 @@ up = (P.wrapColumn2 [(makeExample up [], "move current path up one level (deprecated)")]) \case [] -> Right Input.UpI - _ -> Left (I.help up) + args -> wrongArgsLength "no arguments" args cd :: InputPattern cd = @@ -1480,7 +1515,7 @@ cd = \case [Left ".."] -> Right Input.UpI [p] -> Input.SwitchBranchI <$> handlePath'Arg p - _ -> Left (I.help cd) + args -> wrongArgsLength "exactly one argument" args back :: InputPattern back = @@ -1497,7 +1532,7 @@ back = ) \case [] -> pure Input.PopBranchI - _ -> Left (I.help cd) + args -> wrongArgsLength "no arguments" args deleteNamespace :: InputPattern deleteNamespace = @@ -1507,7 +1542,7 @@ deleteNamespace = I.Visible [("namespace to delete", Required, namespaceArg)] "`delete.namespace ` deletes the namespace `foo`" - (deleteNamespaceParser (I.help deleteNamespace) Input.Try) + (deleteNamespaceParser Input.Try) deleteNamespaceForce :: InputPattern deleteNamespaceForce = @@ -1519,13 +1554,13 @@ deleteNamespaceForce = ( "`delete.namespace.force ` deletes the namespace `foo`," <> "deletion will proceed even if other code depends on definitions in foo." ) - (deleteNamespaceParser (I.help deleteNamespaceForce) Input.Force) + (deleteNamespaceParser Input.Force) -deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input -deleteNamespaceParser helpText insistence = \case +deleteNamespaceParser :: Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input +deleteNamespaceParser insistence = \case [Left "."] -> first fromString . pure $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) - [p] -> Input.DeleteI . DeleteTarget'Namespace insistence . pure <$> handleSplitArg p - _ -> Left helpText + [p] -> Input.DeleteI . DeleteTarget'Namespace insistence <$> (Just <$> handleSplitArg p) + args -> wrongArgsLength "exactly one argument" args renameBranch :: InputPattern renameBranch = @@ -1537,7 +1572,7 @@ renameBranch = "`move.namespace foo bar` renames the path `foo` to `bar`." \case [src, dest] -> Input.MoveBranchI <$> handlePath'Arg src <*> handlePath'Arg dest - _ -> Left (I.help renameBranch) + args -> wrongArgsLength "exactly two arguments" args history :: InputPattern history = @@ -1557,8 +1592,8 @@ history = ) \case [src] -> Input.HistoryI (Just 10) (Just 10) <$> handleBranchIdArg src - [] -> pure $ Input.HistoryI (Just 10) (Just 10) (Right Path.currentPath) - _ -> Left (I.help history) + [] -> pure $ Input.HistoryI (Just 10) (Just 10) (BranchAtPath Path.currentPath) + args -> wrongArgsLength "no more than one argument" args forkLocal :: InputPattern forkLocal = @@ -1583,7 +1618,7 @@ forkLocal = ) \case [src, dest] -> Input.ForkLocalBranchI <$> handleBranchId2Arg src <*> handleBranchRelativePathArg dest - _ -> Left (I.help forkLocal) + args -> wrongArgsLength "exactly two arguments" args libInstallInputPattern :: InputPattern libInstallInputPattern = @@ -1613,7 +1648,7 @@ libInstallInputPattern = ], parse = \case [arg] -> Input.LibInstallI False <$> handleProjectMaybeBranchArg arg - _ -> Left (I.help libInstallInputPattern) + args -> wrongArgsLength "exactly one argument" args } reset :: InputPattern @@ -1625,17 +1660,20 @@ reset = [ ("namespace, hash, or branch to reset to", Required, namespaceOrProjectBranchArg config), ("namespace to be reset", Optional, namespaceOrProjectBranchArg config) ] - ( P.wrapColumn2 - [ ("`reset #pvfd222s8n`", "reset the current namespace to the causal `#pvfd222s8n`"), - ("`reset foo`", "reset the current namespace to that of the `foo` namespace."), - ("`reset foo bar`", "reset the namespace `bar` to that of the `foo` namespace."), - ("`reset #pvfd222s8n /topic`", "reset the branch `topic` of the current project to the causal `#pvfd222s8n`.") + ( P.lines + [ P.wrapColumn2 + [ ("`reset #pvfd222s8n`", "reset the current namespace to the hash `#pvfd222s8n`"), + ("`reset foo`", "reset the current namespace to the state of the `foo` namespace."), + ("`reset #pvfd222s8n /topic`", "reset the branch `topic` of the current project to the causal `#pvfd222s8n`.") + ], + "", + P.wrap $ "If you make a mistake using reset, consult the " <> makeExample' branchReflog <> " command and use another " <> makeExample' reset <> " command to return to a previous state." ] ) \case - [arg0] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> pure Nothing - [arg0, arg1] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> fmap pure (handleLooseCodeOrProjectArg arg1) - _ -> Left $ I.help reset + [resetTo] -> Input.ResetI <$> handleBranchId2Arg resetTo <*> pure Nothing + [resetTo, branchToReset] -> Input.ResetI <$> handleBranchId2Arg resetTo <*> fmap pure (handleMaybeProjectBranchArg branchToReset) + args -> wrongArgsLength "one or two arguments" args where config = ProjectBranchSuggestionsConfig @@ -1644,31 +1682,6 @@ reset = branchInclusion = AllBranches } --- asBranch = tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack inputString) - -resetRoot :: InputPattern -resetRoot = - InputPattern - "reset-root" - [] - I.Hidden - [("namespace or hash to reset to", Required, namespaceArg)] - ( P.lines - [ "Deprecated because it's incompatible with projects. ⚠️ Warning, this command can cause codebase corruption.", - P.wrapColumn2 - [ ( makeExample resetRoot [".foo"], - "Reset the root namespace (along with its history) to that of the `.foo` namespace. Deprecated" - ), - ( makeExample resetRoot ["#9dndk3kbsk13nbpeu"], - "Reset the root namespace (along with its history) to that of the namespace with hash `#9dndk3kbsk13nbpeu`." - ) - ] - ] - ) - $ \case - [src] -> Input.ResetRootI <$> handleBranchIdArg src - _ -> Left (I.help resetRoot) - pull :: InputPattern pull = pullImpl "pull" [] Input.PullWithHistory "" @@ -1764,31 +1777,26 @@ pullImpl name aliases pullMode addendum = do These sourceProject sourceBranch -> Right (Input.LibInstallI True (ProjectAndBranch sourceProject (Just sourceBranch))) (Right source, Left _, Right path) -> - Left . P.indentN 2 $ - P.wrap - ( "I think you're wanting to merge" - <> case source of - RemoteRepo.ReadShare'LooseCode _sourcePath -> "some non-project code" - RemoteRepo.ReadShare'ProjectBranch (This sourceProject) -> - prettyProjectNameSlash sourceProject - RemoteRepo.ReadShare'ProjectBranch (That ProjectBranchNameOrLatestRelease'LatestRelease) -> - "the latest release" - RemoteRepo.ReadShare'ProjectBranch (That (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> - prettySlashProjectBranchName sourceBranch - RemoteRepo.ReadShare'ProjectBranch (These sourceProject ProjectBranchNameOrLatestRelease'LatestRelease) -> - "the latest release of" <> prettyProjectName sourceProject - RemoteRepo.ReadShare'ProjectBranch (These sourceProject (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> - prettyProjectAndBranchName (ProjectAndBranch sourceProject sourceBranch) - <> "into the" - <> prettyPath' path - <> "namespace, but the" - <> makeExample' pull - <> "command only supports merging into the top level of a local project branch." - ) - <> P.newline - <> P.newline - <> P.wrap "Use `help pull` to see some examples." - _ -> Left $ I.help self + Left . P.wrap $ + "I think you want to merge " + <> case source of + RemoteRepo.ReadShare'LooseCode _sourcePath -> "some non-project code" + RemoteRepo.ReadShare'ProjectBranch (This sourceProject) -> + prettyProjectNameSlash sourceProject + RemoteRepo.ReadShare'ProjectBranch (That ProjectBranchNameOrLatestRelease'LatestRelease) -> + "the latest release" + RemoteRepo.ReadShare'ProjectBranch (That (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> + prettySlashProjectBranchName sourceBranch + RemoteRepo.ReadShare'ProjectBranch (These sourceProject ProjectBranchNameOrLatestRelease'LatestRelease) -> + "the latest release of" <> prettyProjectName sourceProject + RemoteRepo.ReadShare'ProjectBranch (These sourceProject (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> + prettyProjectAndBranchName (ProjectAndBranch sourceProject sourceBranch) + <> " into the " + <> prettyPath' path + <> " namespace, but the " + <> makeExample' pull + <> " command only supports merging into the top level of a local project branch." + args -> wrongArgsLength "no more than two arguments" args } debugTabCompletion :: InputPattern @@ -1803,7 +1811,22 @@ debugTabCompletion = P.wrap $ "Completions which are finished are prefixed with a * represent finished completions." ] ) - (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "text")) + (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument debugTabCompletion "text")) + +debugLspNameCompletion :: InputPattern +debugLspNameCompletion = + InputPattern + "debug.lsp-name-completion" + [] + I.Hidden + [("Completion prefix", OnePlus, noCompletionsArg)] + ( P.lines + [ P.wrap $ "This command can be used to test and debug ucm's LSP name-completion within transcripts." + ] + ) + \case + [prefix] -> Input.DebugLSPNameCompletionI . Text.pack <$> unsupportedStructuredArgument debugLspNameCompletion "text" prefix + args -> wrongArgsLength "exactly one argument" args debugFuzzyOptions :: InputPattern debugFuzzyOptions = @@ -1823,9 +1846,9 @@ debugFuzzyOptions = \case (cmd : args) -> Input.DebugFuzzyOptionsI - <$> unsupportedStructuredArgument "a command" cmd - <*> traverse (unsupportedStructuredArgument "text") args - _ -> Left (I.help debugFuzzyOptions) + <$> unsupportedStructuredArgument debugFuzzyOptions "a command" cmd + <*> traverse (unsupportedStructuredArgument debugFuzzyOptions "text") args + args -> wrongArgsLength "at least one argument" args debugFormat :: InputPattern debugFormat = @@ -1841,7 +1864,7 @@ debugFormat = ) ( \case [] -> Right Input.DebugFormatI - _ -> Left (I.help debugFormat) + args -> wrongArgsLength "no arguments" args ) push :: InputPattern @@ -1888,7 +1911,7 @@ push = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help push) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1939,7 +1962,7 @@ pushCreate = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help pushForce) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1969,7 +1992,7 @@ pushForce = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help pushForce) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2009,7 +2032,7 @@ pushExhaustive = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help pushExhaustive) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2036,12 +2059,17 @@ mergeOldSquashInputPattern = <> "The resulting `dest` will have (at most) 1" <> "additional history entry.", parse = \case + [src] -> + Input.MergeLocalBranchI + <$> handleBranchRelativePathArg src + <*> pure Nothing + <*> pure Branch.SquashMerge [src, dest] -> Input.MergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> handleLooseCodeOrProjectArg dest + <$> handleBranchRelativePathArg src + <*> (Just <$> handleBranchRelativePathArg dest) <*> pure Branch.SquashMerge - _ -> Left $ I.help mergeOldSquashInputPattern + args -> wrongArgsLength "exactly two arguments" args } where suggestionsConfig = @@ -2072,27 +2100,21 @@ mergeOldInputPattern = ), ( makeExample mergeOldInputPattern ["/topic", "foo/main"], "merges the branch `topic` of the current project into the `main` branch of the project 'foo`" - ), - ( makeExample mergeOldInputPattern [".src"], - "merges `.src` namespace into the current namespace" - ), - ( makeExample mergeOldInputPattern [".src", ".dest"], - "merges `.src` namespace into the `dest` namespace" ) ] ) ( \case [src] -> Input.MergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> pure (This Path.relativeEmpty') + <$> handleBranchRelativePathArg src + <*> pure Nothing <*> pure Branch.RegularMerge [src, dest] -> Input.MergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> handleLooseCodeOrProjectArg dest + <$> handleBranchRelativePathArg src + <*> (Just <$> handleBranchRelativePathArg dest) <*> pure Branch.RegularMerge - _ -> Left $ I.help mergeOldInputPattern + args -> wrongArgsLength "one or two arguments" args ) where config = @@ -2122,9 +2144,8 @@ mergeInputPattern = help = P.wrap $ makeExample mergeInputPattern ["/branch"] <> "merges `branch` into the current branch", parse = \case - [branchString] -> - Input.MergeI <$> handleMaybeProjectBranchArg branchString - _ -> Left $ I.help mergeInputPattern + [branchString] -> Input.MergeI <$> handleMaybeProjectBranchArg branchString + args -> wrongArgsLength "exactly one argument" args } mergeCommitInputPattern :: InputPattern @@ -2166,20 +2187,9 @@ mergeCommitInputPattern = ), parse = \case [] -> Right Input.MergeCommitI - _ -> Left (I.help mergeCommitInputPattern) + args -> wrongArgsLength "no arguments" args } -parseLooseCodeOrProject :: String -> Maybe Input.LooseCodeOrProject -parseLooseCodeOrProject inputString = - case (asLooseCode, asBranch) of - (Right path, Left _) -> Just (This path) - (Left _, Right branch) -> Just (That branch) - (Right path, Right branch) -> Just (These path branch) - (Left _, Left _) -> Nothing - where - asLooseCode = Path.parsePath' inputString - asBranch = tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack inputString) - diffNamespace :: InputPattern diffNamespace = InputPattern @@ -2197,9 +2207,9 @@ diffNamespace = ] ) ( \case - [before, after] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> handleBranchIdArg after - [before] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> pure (pure Path.currentPath) - _ -> Left $ I.help diffNamespace + [before, after] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> handleBranchId2Arg after + [before] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> pure (Right . UnqualifiedPath $ Path.currentPath) + args -> wrongArgsLength "one or two arguments" args ) where suggestionsConfig = @@ -2226,10 +2236,10 @@ mergeOldPreviewInputPattern = ] ) ( \case - [src] -> Input.PreviewMergeLocalBranchI <$> handleLooseCodeOrProjectArg src <*> pure (This Path.relativeEmpty') + [src] -> Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> pure Nothing [src, dest] -> - Input.PreviewMergeLocalBranchI <$> handleLooseCodeOrProjectArg src <*> handleLooseCodeOrProjectArg dest - _ -> Left $ I.help mergeOldPreviewInputPattern + Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> (Just <$> handleBranchRelativePathArg dest) + args -> wrongArgsLength "one or two arguments" args ) where suggestionsConfig = @@ -2239,19 +2249,74 @@ mergeOldPreviewInputPattern = branchInclusion = AllBranches } -viewReflog :: InputPattern -viewReflog = +deprecatedViewRootReflog :: InputPattern +deprecatedViewRootReflog = InputPattern - "reflog" + "deprecated.root-reflog" [] I.Visible [] - "`reflog` lists the changes that have affected the root namespace" + ( "`deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of " + <> makeExample branchReflog [] + <> " which shows the reflog for the current project." + ) ( \case - [] -> pure Input.ShowReflogI + [] -> pure Input.ShowRootReflogI _ -> - Left . warn . P.string $ - I.patternName viewReflog ++ " doesn't take any arguments." + Left . P.string $ + I.patternName deprecatedViewRootReflog ++ " doesn't take any arguments." + ) + +branchReflog :: InputPattern +branchReflog = + InputPattern + "branch.reflog" + ["reflog.branch", "reflog"] + I.Visible + [] + ( P.lines + [ "`branch.reflog` lists all the changes that have affected the current branch.", + "`branch.reflog /mybranch` lists all the changes that have affected /mybranch." + ] + ) + ( \case + [] -> pure $ Input.ShowProjectBranchReflogI Nothing + [branchRef] -> Input.ShowProjectBranchReflogI <$> (Just <$> handleMaybeProjectBranchArg branchRef) + _ -> Left (I.help branchReflog) + ) + +projectReflog :: InputPattern +projectReflog = + InputPattern + "project.reflog" + ["reflog.project"] + I.Visible + [] + ( P.lines + [ "`project.reflog` lists all the changes that have affected any branches in the current project.", + "`project.reflog myproject` lists all the changes that have affected any branches in myproject." + ] + ) + ( \case + [] -> pure $ Input.ShowProjectReflogI Nothing + [projectRef] -> Input.ShowProjectReflogI <$> (Just <$> handleProjectArg projectRef) + _ -> Left (I.help projectReflog) + ) + +globalReflog :: InputPattern +globalReflog = + InputPattern + "reflog.global" + [] + I.Visible + [] + ( P.lines + [ "`reflog.global` lists all recent changes across all projects and branches." + ] + ) + ( \case + [] -> pure $ Input.ShowGlobalReflogI + _ -> Left (I.help globalReflog) ) edit :: InputPattern @@ -2269,7 +2334,7 @@ edit = ], parse = maybe - (Left $ I.help edit) + (wrongArgsLength "at least one argument" []) ( fmap (Input.ShowDefinitionI Input.LatestFileLocation Input.ShowDefinitionLocal) . traverse handleHashQualifiedNameArg ) @@ -2309,13 +2374,13 @@ helpTopics = [("topic", Optional, topicNameArg)] ("`help-topics` lists all topics and `help-topics ` shows an explanation of that topic.") ( \case - [] -> Left topics + [] -> Right $ Input.CreateMessage topics [topic] -> do - topic <- unsupportedStructuredArgument "a help topic" topic + topic <- unsupportedStructuredArgument helpTopics "a help topic" topic case Map.lookup topic helpTopicsMap of - Nothing -> Left . warn $ "I don't know of that topic. Try `help-topics`." - Just t -> Left t - _ -> Left $ warn "Use `help-topics ` or `help-topics`." + Nothing -> Left $ "I don't know of that topic. Try `help-topics`." + Just t -> Right $ Input.CreateMessage t + _ -> Left $ "Use `help-topics ` or `help-topics`." ) where topics = @@ -2325,7 +2390,7 @@ helpTopics = "", P.indentN 2 $ P.sep "\n" (P.string <$> Map.keys helpTopicsMap), "", - aside "Example" "use `help filestatus` to learn more about that topic." + aside "Example" "use `help-topics filestatus` to learn more about that topic." ] helpTopicsMap :: Map String (P.Pretty P.ColorText) @@ -2494,21 +2559,21 @@ help = "`help` shows general help and `help ` shows help for one command." $ \case [] -> - Left $ + Right . Input.CreateMessage $ intercalateMap "\n\n" showPatternHelp visibleInputs [cmd] -> do - cmd <- unsupportedStructuredArgument "a command" cmd + cmd <- unsupportedStructuredArgument help "a command" cmd case (Map.lookup cmd commandsByName, isHelp cmd) of - (Nothing, Just msg) -> Left msg - (Nothing, Nothing) -> Left . warn $ "I don't know of that command. Try `help`." - (Just pat, Nothing) -> Left $ showPatternHelp pat + (Nothing, Just msg) -> Right $ Input.CreateMessage msg + (Nothing, Nothing) -> Left $ "I don't know of that command. Try" <> makeExampleEOS help [] + (Just pat, Nothing) -> Right . Input.CreateMessage $ showPatternHelp pat -- If we have a command and a help topic with the same name (like "projects"), then append a tip to the -- command's help that suggests running `help-topic command` (Just pat, Just _) -> - Left $ + Right . Input.CreateMessage $ showPatternHelp pat <> P.newline <> P.newline @@ -2518,7 +2583,7 @@ help = <> "use" <> makeExample helpTopics [P.string cmd] ) - _ -> Left $ warn "Use `help ` or `help`." + _ -> Left "Use `help ` or `help`." where commandsByName = Map.fromList $ do @@ -2549,7 +2614,7 @@ names isGlobal = (P.wrap $ makeExample (names isGlobal) ["foo"] <> " shows the hash and all known names for `foo`.") $ \case [thing] -> Input.NamesI isGlobal <$> handleHashQualifiedNameArg thing - _ -> Left (I.help (names isGlobal)) + args -> wrongArgsLength "exactly one argument" args where cmdName = if isGlobal then "names.global" else "names" @@ -2563,7 +2628,7 @@ dependents = "List the named dependents of the specified definition." $ \case [thing] -> Input.ListDependentsI <$> handleHashQualifiedNameArg thing - _ -> Left (I.help dependents) + args -> wrongArgsLength "exactly one argument" args dependencies = InputPattern "dependencies" @@ -2573,7 +2638,7 @@ dependencies = "List the dependencies of the specified definition." $ \case [thing] -> Input.ListDependenciesI <$> handleHashQualifiedNameArg thing - _ -> Left (I.help dependencies) + args -> wrongArgsLength "exactly one argument" args namespaceDependencies :: InputPattern namespaceDependencies = @@ -2586,7 +2651,7 @@ namespaceDependencies = $ \case [p] -> Input.NamespaceDependenciesI . pure <$> handlePath'Arg p [] -> pure (Input.NamespaceDependenciesI Nothing) - _ -> Left (I.help namespaceDependencies) + args -> wrongArgsLength "no more than one argument" args debugNumberedArgs :: InputPattern debugNumberedArgs = @@ -2638,7 +2703,7 @@ debugTerm = "View debugging information for a given term." ( \case [thing] -> Input.DebugTermI False <$> handleHashQualifiedNameArg thing - _ -> Left (I.help debugTerm) + args -> wrongArgsLength "exactly one argument" args ) debugTermVerbose :: InputPattern @@ -2651,7 +2716,7 @@ debugTermVerbose = "View verbose debugging information for a given term." ( \case [thing] -> Input.DebugTermI True <$> handleHashQualifiedNameArg thing - _ -> Left (I.help debugTermVerbose) + args -> wrongArgsLength "exactly one argument" args ) debugType :: InputPattern @@ -2664,7 +2729,7 @@ debugType = "View debugging information for a given type." ( \case [thing] -> Input.DebugTypeI <$> handleHashQualifiedNameArg thing - _ -> Left (I.help debugType) + args -> wrongArgsLength "exactly one argument" args ) debugLSPFoldRanges :: InputPattern @@ -2698,7 +2763,7 @@ debugDoctor = ) ( \case [] -> Right $ Input.DebugDoctorI - _ -> Left (showPatternHelp debugDoctor) + args -> wrongArgsLength "no arguments" args ) debugNameDiff :: InputPattern @@ -2711,7 +2776,7 @@ debugNameDiff = help = P.wrap "List all name changes between two causal hashes. Does not detect patch changes.", parse = \case [from, to] -> Input.DebugNameDiffI <$> handleShortCausalHashArg from <*> handleShortCausalHashArg to - _ -> Left (I.help debugNameDiff) + args -> wrongArgsLength "exactly two arguments" args } test :: InputPattern @@ -2740,7 +2805,7 @@ test = . \case [] -> pure Path.empty [pathString] -> handlePathArg pathString - _ -> Left $ I.help test + args -> wrongArgsLength "no more than one argument" args } testAll :: InputPattern @@ -2768,20 +2833,22 @@ docsToHtml = "docs.to-html" [] I.Visible - [("namespace", Required, namespaceArg), ("", Required, filePathArg)] + [("namespace", Required, branchRelativePathArg), ("", Required, filePathArg)] ( P.wrapColumn2 - [ ( "`docs.to-html .path.to.namespace ~/path/to/file/output`", - "Render all docs contained within a namespace, no matter how deep," - <> "to html files on a file path" + [ ( makeExample docsToHtml [".path.to.ns", "doc-dir"], + "Render all docs contained within the namespace `.path.to.ns`, no matter how deep, to html files in `doc-dir` in the directory UCM was run from." + ), + ( makeExample docsToHtml ["project0/branch0:a.path", "/tmp/doc-dir"], + "Renders all docs anywhere in the namespace `a.path` from `branch0` of `project0` to html in `/tmp/doc-dir`." ) ] ) \case [namespacePath, destinationFilePath] -> Input.DocsToHtmlI - <$> handlePath'Arg namespacePath - <*> unsupportedStructuredArgument "a file name" destinationFilePath - _ -> Left $ showPatternHelp docsToHtml + <$> handleBranchRelativePathArg namespacePath + <*> unsupportedStructuredArgument docsToHtml "a file name" destinationFilePath + args -> wrongArgsLength "exactly two arguments" args docToMarkdown :: InputPattern docToMarkdown = @@ -2798,7 +2865,7 @@ docToMarkdown = ) \case [docNameText] -> Input.DocToMarkdownI <$> handleNameArg docNameText - _ -> Left $ showPatternHelp docToMarkdown + args -> wrongArgsLength "exactly one argument" args execute :: InputPattern execute = @@ -2820,8 +2887,8 @@ execute = main : args -> Input.ExecuteI <$> handleHashQualifiedNameArg main - <*> traverse (unsupportedStructuredArgument "a command-line argument") args - _ -> Left $ showPatternHelp execute + <*> traverse (unsupportedStructuredArgument execute "a command-line argument") args + [] -> wrongArgsLength "at least one argument" [] saveExecuteResult :: InputPattern saveExecuteResult = @@ -2835,7 +2902,7 @@ saveExecuteResult = ) $ \case [w] -> Input.SaveExecuteResultI <$> handleNameArg w - _ -> Left $ showPatternHelp saveExecuteResult + args -> wrongArgsLength "exactly one argument" args ioTest :: InputPattern ioTest = @@ -2852,7 +2919,7 @@ ioTest = ], parse = \case [thing] -> Input.IOTestI <$> handleHashQualifiedNameArg thing - _ -> Left $ showPatternHelp ioTest + args -> wrongArgsLength "exactly one argument" args } ioTestAll :: InputPattern @@ -2870,7 +2937,7 @@ ioTestAll = ], parse = \case [] -> Right Input.IOTestAllI - _ -> Left $ showPatternHelp ioTest + args -> wrongArgsLength "no arguments" args } makeStandalone :: InputPattern @@ -2891,9 +2958,9 @@ makeStandalone = $ \case [main, file] -> Input.MakeStandaloneI - <$> unsupportedStructuredArgument "a file name" file + <$> unsupportedStructuredArgument makeStandalone "a file name" file <*> handleHashQualifiedNameArg main - _ -> Left $ showPatternHelp makeStandalone + args -> wrongArgsLength "exactly two arguments" args runScheme :: InputPattern runScheme = @@ -2912,8 +2979,8 @@ runScheme = main : args -> Input.ExecuteSchemeI <$> handleHashQualifiedNameArg main - <*> traverse (unsupportedStructuredArgument "a command-line argument") args - _ -> Left $ showPatternHelp runScheme + <*> traverse (unsupportedStructuredArgument runScheme "a command-line argument") args + [] -> wrongArgsLength "at least one argument" [] compileScheme :: InputPattern compileScheme = @@ -2933,9 +3000,9 @@ compileScheme = $ \case [main, file] -> Input.CompileSchemeI . Text.pack - <$> unsupportedStructuredArgument "a file name" file + <$> unsupportedStructuredArgument compileScheme "a file name" file <*> handleHashQualifiedNameArg main - _ -> Left $ showPatternHelp compileScheme + args -> wrongArgsLength "exactly two arguments" args createAuthor :: InputPattern createAuthor = @@ -2959,8 +3026,10 @@ createAuthor = symbolStr : authorStr@(_ : _) -> Input.CreateAuthorI <$> handleRelativeNameSegmentArg symbolStr - <*> fmap (parseAuthorName . unwords) (traverse (unsupportedStructuredArgument "text") authorStr) - _ -> Left $ showPatternHelp createAuthor + <*> fmap + (parseAuthorName . unwords) + (traverse (unsupportedStructuredArgument createAuthor "text") authorStr) + args -> wrongArgsLength "at least two arguments" args where -- let's have a real parser in not too long parseAuthorName :: String -> Text @@ -2984,7 +3053,7 @@ authLogin = ) ( \case [] -> Right $ Input.AuthLoginI - _ -> Left (showPatternHelp authLogin) + args -> wrongArgsLength "no arguments" args ) printVersion :: InputPattern @@ -2998,7 +3067,7 @@ printVersion = ) ( \case [] -> Right $ Input.VersionI - _ -> Left (showPatternHelp printVersion) + args -> wrongArgsLength "no arguments" args ) projectCreate :: InputPattern @@ -3016,7 +3085,7 @@ projectCreate = parse = \case [] -> pure $ Input.ProjectCreateI True Nothing [name] -> Input.ProjectCreateI True . pure <$> handleProjectArg name - _ -> Left $ showPatternHelp projectCreate + args -> wrongArgsLength "no more than one argument" args } projectCreateEmptyInputPattern :: InputPattern @@ -3034,7 +3103,7 @@ projectCreateEmptyInputPattern = parse = \case [] -> pure $ Input.ProjectCreateI False Nothing [name] -> Input.ProjectCreateI False . pure <$> handleProjectArg name - _ -> Left $ showPatternHelp projectCreateEmptyInputPattern + args -> wrongArgsLength "no more than one argument" args } projectRenameInputPattern :: InputPattern @@ -3050,7 +3119,7 @@ projectRenameInputPattern = ], parse = \case [nameString] -> Input.ProjectRenameI <$> handleProjectArg nameString - _ -> Left (showPatternHelp projectRenameInputPattern) + args -> wrongArgsLength "exactly one argument" args } projectSwitch :: InputPattern @@ -3069,7 +3138,7 @@ projectSwitch = ], parse = \case [name] -> Input.ProjectSwitchI <$> handleProjectAndBranchNamesArg name - _ -> Left (showPatternHelp projectSwitch) + args -> wrongArgsLength "exactly one argument" args } where suggestionsConfig = @@ -3105,7 +3174,7 @@ branchesInputPattern = parse = \case [] -> Right (Input.BranchesI Nothing) [nameString] -> Input.BranchesI . pure <$> handleProjectArg nameString - _ -> Left (showPatternHelp branchesInputPattern) + args -> wrongArgsLength "no more than one argument" args } branchInputPattern :: InputPattern @@ -3121,16 +3190,15 @@ branchInputPattern = help = P.wrapColumn2 [ ("`branch foo`", "forks the current project branch to a new branch `foo`"), - ("`branch /bar foo`", "forks the branch `bar` of the current project to a new branch `foo`"), - ("`branch .bar foo`", "forks the path `.bar` of the current project to a new branch `foo`") + ("`branch /bar foo`", "forks the branch `bar` of the current project to a new branch `foo`") ], parse = \case [source0, name] -> - Input.BranchI . Input.BranchSourceI'LooseCodeOrProject - <$> handleLooseCodeOrProjectArg source0 + Input.BranchI . Input.BranchSourceI'UnresolvedProjectBranch + <$> handleMaybeProjectBranchArg source0 <*> handleMaybeProjectBranchArg name [name] -> Input.BranchI Input.BranchSourceI'CurrentContext <$> handleMaybeProjectBranchArg name - _ -> Left $ showPatternHelp branchInputPattern + args -> wrongArgsLength "one or two arguments" args } where newBranchNameArg = @@ -3158,7 +3226,7 @@ branchEmptyInputPattern = [name] -> Input.BranchI Input.BranchSourceI'Empty <$> handleMaybeProjectBranchArg name - _ -> Left (showPatternHelp branchEmptyInputPattern) + args -> wrongArgsLength "exactly one argument" args } branchRenameInputPattern :: InputPattern @@ -3173,7 +3241,7 @@ branchRenameInputPattern = [("`branch.rename foo`", "renames the current branch to `foo`")], parse = \case [name] -> Input.BranchRenameI <$> handleProjectBranchNameArg name - _ -> Left (showPatternHelp branchRenameInputPattern) + args -> wrongArgsLength "exactly one argument" args } clone :: InputPattern @@ -3211,7 +3279,7 @@ clone = Input.CloneI <$> handleProjectAndBranchNamesArg remoteNames <*> fmap pure (handleProjectAndBranchNamesArg localNames) - _ -> Left $ showPatternHelp clone + args -> wrongArgsLength "one or two arguments" args } releaseDraft :: InputPattern @@ -3227,8 +3295,8 @@ releaseDraft = bimap (const "Couldn’t parse version number") Input.ReleaseDraftI . tryInto @Semver . Text.pack - =<< unsupportedStructuredArgument "a version number" semverString - _ -> Left (showPatternHelp releaseDraft) + =<< unsupportedStructuredArgument releaseDraft "a version number" semverString + args -> wrongArgsLength "exactly one argument" args } upgrade :: InputPattern @@ -3244,7 +3312,7 @@ upgrade = parse = \case [oldString, newString] -> Input.UpgradeI <$> handleRelativeNameSegmentArg oldString <*> handleRelativeNameSegmentArg newString - _ -> Left $ I.help upgrade + args -> wrongArgsLength "exactly two arguments" args } upgradeCommitInputPattern :: InputPattern @@ -3286,7 +3354,20 @@ upgradeCommitInputPattern = ), parse = \case [] -> Right Input.UpgradeCommitI - _ -> Left (I.help upgradeCommitInputPattern) + args -> wrongArgsLength "no arguments" args + } + +debugSynhashTermInputPattern :: InputPattern +debugSynhashTermInputPattern = + InputPattern + { patternName = "debug.synhash.term", + aliases = [], + visibility = I.Hidden, + args = [("term", Required, exactDefinitionTermQueryArg)], + help = mempty, + parse = \case + [arg] -> Input.DebugSynhashTermI <$> handleNameArg arg + args -> wrongArgsLength "exactly one argument" args } validInputs :: [InputPattern] @@ -3309,10 +3390,13 @@ validInputs = clone, compileScheme, createAuthor, + debugAliasTermForce, + debugAliasTypeForce, debugClearWatchCache, debugDoctor, debugDumpNamespace, debugDumpNamespaceSimple, + debugSynhashTermInputPattern, debugTerm, debugTermVerbose, debugType, @@ -3321,6 +3405,7 @@ validInputs = debugNameDiff, debugNumberedArgs, debugTabCompletion, + debugLspNameCompletion, debugFuzzyOptions, debugFormat, delete, @@ -3394,7 +3479,6 @@ validInputs = renameType, moveAll, reset, - resetRoot, runScheme, saveExecuteResult, test, @@ -3411,7 +3495,10 @@ validInputs = upgradeCommitInputPattern, view, viewGlobal, - viewReflog + deprecatedViewRootReflog, + branchReflog, + projectReflog, + globalReflog ] -- | A map of all command patterns by pattern name or alias. @@ -3493,7 +3580,7 @@ namespaceOrProjectBranchArg config = ArgumentType { typeName = "namespace or branch", suggestions = - let namespaceSuggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteNamespace q p) + let namespaceSuggestions = \q cb _http pp -> Codebase.runTransaction cb (prefixCompleteNamespace q pp) in unionSuggestions [ projectAndOrBranchSuggestions config, namespaceSuggestions @@ -3519,8 +3606,8 @@ dependencyArg :: ArgumentType dependencyArg = ArgumentType { typeName = "project dependency", - suggestions = \q cb _http p -> Codebase.runTransaction cb do - prefixCompleteNamespace q (p Path.:> NameSegment.libSegment), + suggestions = \q cb _http pp -> Codebase.runTransaction cb do + prefixCompleteNamespace q (pp & PP.path_ .~ Path.singleton NameSegment.libSegment), fzfResolver = Just Resolvers.projectDependencyResolver } @@ -3579,14 +3666,14 @@ projectAndOrBranchSuggestions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> -- Current path + ProjectPath -> m [Line.Completion] -projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do +projectAndOrBranchSuggestions config inputStr codebase _httpClient pp = do case Text.uncons input of -- Things like "/foo" would be parsed as unambiguous branches in the logic below, except we also want to -- handle "/" and "/@" inputs, which aren't valid branch names, but are valid branch prefixes. So, -- if the input begins with a forward slash, just rip it off and treat the rest as the branch prefix. - Just ('/', input1) -> handleBranchesComplete input1 codebase path + Just ('/', input1) -> handleBranchesComplete input1 codebase pp _ -> case tryInto @ProjectAndBranchNames input of -- This case handles inputs like "", "@", and possibly other things that don't look like a valid project @@ -3607,12 +3694,12 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do Nothing -> pure [] Just project -> do let projectId = project ^. #projectId - fmap (filterBranches config path) do + fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projectId Nothing pure (map (projectBranchToCompletion projectName) branches) -- This branch is probably dead due to intercepting inputs that begin with "/" above Right (ProjectAndBranchNames'Unambiguous (That branchName)) -> - handleBranchesComplete (into @Text branchName) codebase path + handleBranchesComplete (into @Text branchName) codebase pp Right (ProjectAndBranchNames'Unambiguous (These projectName branchName)) -> do branches <- Codebase.runTransaction codebase do @@ -3620,16 +3707,12 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do Nothing -> pure [] Just project -> do let projectId = project ^. #projectId - fmap (filterBranches config path) do + fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projectId (Just $ into @Text branchName) pure (map (projectBranchToCompletion projectName) branches) where input = Text.strip . Text.pack $ inputStr - (mayCurrentProjectId, _mayCurrentBranchId) = case projectContextFromPath path of - LooseCodePath {} -> (Nothing, Nothing) - ProjectBranchPath projectId branchId _ -> (Just projectId, Just branchId) - handleAmbiguousComplete :: (MonadIO m) => Text -> @@ -3639,14 +3722,10 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do (branches, projects) <- Codebase.runTransaction codebase do branches <- - case mayCurrentProjectId of - Nothing -> pure [] - Just currentProjectId -> - fmap (filterBranches config path) do - Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just input) - projects <- case (projectInclusion config, mayCurrentProjectId) of - (OnlyWithinCurrentProject, Just currentProjectId) -> Queries.loadProject currentProjectId <&> maybeToList - (OnlyWithinCurrentProject, Nothing) -> pure [] + fmap (filterBranches config pp) do + Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just input) + projects <- case projectInclusion config of + OnlyWithinCurrentProject -> Queries.loadProject currentProjectId <&> maybeToList _ -> Queries.loadAllProjectsBeginningWith (Just input) <&> filterProjects pure (branches, projects) let branchCompletions = map currentProjectBranchToCompletion branches @@ -3720,28 +3799,28 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do then projectCompletions else branchCompletions ++ projectCompletions - handleBranchesComplete :: (MonadIO m) => Text -> Codebase m v a -> Path.Absolute -> m [Completion] - handleBranchesComplete branchName codebase path = do + -- Complete the text into a branch name within the provided project + handleBranchesComplete :: (MonadIO m) => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion] + handleBranchesComplete branchName codebase pp = do + let projId = pp ^. #project . #projectId branches <- - case preview ProjectUtils.projectBranchPathPrism path of - Nothing -> pure [] - Just (ProjectAndBranch currentProjectId _, _) -> - Codebase.runTransaction codebase do - fmap (filterBranches config path) do - Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just branchName) + Codebase.runTransaction codebase do + fmap (filterBranches config pp) do + Queries.loadAllProjectBranchesBeginningWith projId (Just branchName) pure (map currentProjectBranchToCompletion branches) filterProjects :: [Sqlite.Project] -> [Sqlite.Project] filterProjects projects = - case (mayCurrentProjectId, projectInclusion config) of - (_, AllProjects) -> projects - (Nothing, _) -> projects - (Just currentProjId, OnlyOutsideCurrentProject) -> projects & filter (\Sqlite.Project {projectId} -> projectId /= currentProjId) - (Just currentBranchId, OnlyWithinCurrentProject) -> + case (projectInclusion config) of + AllProjects -> projects + OnlyOutsideCurrentProject -> projects & filter (\Sqlite.Project {projectId} -> projectId /= currentProjectId) + OnlyWithinCurrentProject -> projects - & List.find (\Sqlite.Project {projectId} -> projectId == currentBranchId) + & List.find (\Sqlite.Project {projectId} -> projectId == currentProjectId) & maybeToList + PP.ProjectPath currentProjectId _currentBranchId _currentPath = PP.toIds pp + projectToCompletion :: Sqlite.Project -> Completion projectToCompletion project = Completion @@ -3765,28 +3844,22 @@ handleBranchesComplete :: ProjectBranchSuggestionsConfig -> Text -> Codebase m v a -> - Path.Absolute -> + PP.ProjectPath -> m [Completion] -handleBranchesComplete config branchName codebase path = do +handleBranchesComplete config branchName codebase pp = do branches <- - case preview ProjectUtils.projectBranchPathPrism path of - Nothing -> pure [] - Just (ProjectAndBranch currentProjectId _, _) -> - Codebase.runTransaction codebase do - fmap (filterBranches config path) do - Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just branchName) + Codebase.runTransaction codebase do + fmap (filterBranches config pp) do + Queries.loadAllProjectBranchesBeginningWith (pp ^. #project . #projectId) (Just branchName) pure (map currentProjectBranchToCompletion branches) -filterBranches :: ProjectBranchSuggestionsConfig -> Path.Absolute -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] -filterBranches config path branches = - case (mayCurrentBranchId, branchInclusion config) of - (_, AllBranches) -> branches - (Nothing, _) -> branches - (Just currentBranchId, ExcludeCurrentBranch) -> branches & filter (\(branchId, _) -> branchId /= currentBranchId) +filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] +filterBranches config pp branches = + case (branchInclusion config) of + AllBranches -> branches + ExcludeCurrentBranch -> branches & filter (\(branchId, _) -> branchId /= currentBranchId) where - (_mayCurrentProjectId, mayCurrentBranchId) = case projectContextFromPath path of - LooseCodePath {} -> (Nothing, Nothing) - ProjectBranchPath projectId branchId _ -> (Just projectId, Just branchId) + currentBranchId = pp ^. #branch . #branchId currentProjectBranchToCompletion :: (ProjectBranchId, ProjectBranchName) -> Completion currentProjectBranchToCompletion (_, branchName) = @@ -3802,22 +3875,22 @@ branchRelativePathSuggestions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> -- Current path + PP.ProjectPath -> m [Line.Completion] -branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = do +branchRelativePathSuggestions config inputStr codebase _httpClient pp = do case parseIncrementalBranchRelativePath inputStr of Left _ -> pure [] Right ibrp -> case ibrp of - BranchRelativePath.ProjectOrRelative _txt _path -> do - namespaceSuggestions <- Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath) + BranchRelativePath.ProjectOrPath' _txt _path -> do + namespaceSuggestions <- Codebase.runTransaction codebase (prefixCompleteNamespace inputStr pp) projectSuggestions <- projectNameSuggestions WithSlash inputStr codebase pure (namespaceSuggestions ++ projectSuggestions) - BranchRelativePath.LooseCode _path -> - Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath) + BranchRelativePath.OnlyPath' _path -> + Codebase.runTransaction codebase (prefixCompleteNamespace inputStr pp) BranchRelativePath.IncompleteProject _proj -> projectNameSuggestions WithSlash inputStr codebase BranchRelativePath.IncompleteBranch mproj mbranch -> case mproj of - Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase currentPath + Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase pp Just projectName -> do branches <- Codebase.runTransaction codebase do @@ -3825,44 +3898,15 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = Nothing -> pure [] Just project -> do let projectId = project ^. #projectId - fmap (filterBranches config currentPath) do + fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projectId (into @Text <$> mbranch) pure (map (projectBranchToCompletionWithSep projectName) branches) - BranchRelativePath.PathRelativeToCurrentBranch relPath -> Codebase.runTransaction codebase do - mprojectBranch <- runMaybeT do - (projectId, branchId) <- MaybeT (pure $ (,) <$> mayCurrentProjectId <*> mayCurrentBranchId) - MaybeT (Queries.loadProjectBranch projectId branchId) - case mprojectBranch of - Nothing -> pure [] - Just projectBranch -> do - let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty) - projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId) - map prefixPathSep - <$> prefixCompleteNamespace (Text.unpack . Path.toText' $ Path.RelativePath' relPath) branchPath + BranchRelativePath.PathRelativeToCurrentBranch absPath -> Codebase.runTransaction codebase do + map prefixPathSep <$> prefixCompleteNamespace (Text.unpack . Path.toText' $ Path.AbsolutePath' absPath) pp BranchRelativePath.IncompletePath projStuff mpath -> do Codebase.runTransaction codebase do - mprojectBranch <- runMaybeT do - case projStuff of - Left names@(ProjectAndBranch projectName branchName) -> do - (,Left names) <$> MaybeT (Queries.loadProjectBranchByNames projectName branchName) - Right branchName -> do - currentProjectId <- MaybeT (pure mayCurrentProjectId) - projectBranch <- MaybeT (Queries.loadProjectBranchByName currentProjectId branchName) - pure (projectBranch, Right (projectBranch ^. #name)) - case mprojectBranch of - Nothing -> pure [] - Just (projectBranch, prefix) -> do - let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty) - projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId) - map (addBranchPrefix prefix) - <$> prefixCompleteNamespace - (maybe "" (Text.unpack . Path.toText' . Path.RelativePath') mpath) - branchPath + map (addBranchPrefix projStuff) <$> prefixCompleteNamespace (maybe "" (Text.unpack . Path.toText' . Path.AbsolutePath') mpath) pp where - (mayCurrentProjectId, mayCurrentBranchId) = case projectContextFromPath currentPath of - LooseCodePath {} -> (Nothing, Nothing) - ProjectBranchPath projectId branchId _ -> (Just projectId, Just branchId) - projectBranchToCompletionWithSep :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion projectBranchToCompletionWithSep projectName (_, branchName) = Completion @@ -3987,12 +4031,11 @@ projectNameSuggestions slash (Text.strip . Text.pack -> input) codebase = do parsePushSource :: String -> Maybe Input.PushSource parsePushSource sourceStr = fixup Input.ProjySource (tryFrom $ Text.pack sourceStr) - <|> fixup Input.PathySource (Path.parsePath' sourceStr) where fixup = either (const Nothing) . (pure .) -- | Parse a push target. -parsePushTarget :: String -> Maybe (WriteRemoteNamespace (These ProjectName ProjectBranchName)) +parsePushTarget :: String -> Maybe (These ProjectName ProjectBranchName) parsePushTarget = Megaparsec.parseMaybe UriParser.writeRemoteNamespace . Text.pack parseHashQualifiedName :: @@ -4000,7 +4043,6 @@ parseHashQualifiedName :: parseHashQualifiedName s = maybe ( Left - . P.warnCallout . P.wrap $ P.string s <> " is not a well-formed name, hash, or hash-qualified name. " diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 451ec731ba..914581664b 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -6,10 +6,13 @@ where import Compat (withInterruptHandler) import Control.Concurrent.Async qualified as Async import Control.Exception (catch, displayException, finally, mask) -import Control.Lens (preview, (?~)) +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 import Data.Text qualified as Text import Data.Text.IO qualified as Text import Ki qualified @@ -18,24 +21,21 @@ import System.Console.Haskeline qualified as Line import System.Console.Haskeline.History qualified as Line import System.IO (hGetEcho, hPutStrLn, hSetEcho, stderr, stdin) import System.IO.Error (isDoesNotExistError) -import U.Codebase.HashTags (CausalHash) -import U.Codebase.Sqlite.Operations qualified as Operations -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Auth.CredentialManager (newCredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Auth.HTTPClient qualified as AuthN import Unison.Auth.Tokens qualified as AuthN import Unison.Cli.Monad qualified as Cli -import Unison.Cli.Pretty (prettyProjectAndBranchName) -import Unison.Cli.ProjectUtils (projectBranchPathPrism) +import Unison.Cli.Pretty qualified as P +import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch (Branch) import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event, Input (..)) import Unison.Codebase.Editor.Output (NumberedArgs, Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime import Unison.CommandLine import Unison.CommandLine.Completion (haskelineTabComplete) @@ -46,7 +46,6 @@ import Unison.CommandLine.Welcome qualified as Welcome import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyTerminal -import Unison.Project (ProjectAndBranch (..)) import Unison.Runtime.IOSource qualified as IOSource import Unison.Server.CodebaseServer qualified as Server import Unison.Symbol (Symbol) @@ -60,10 +59,11 @@ import UnliftIO.STM getUserInput :: Codebase IO Symbol Ann -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> + IO (Branch IO) -> NumberedArgs -> IO Input -getUserInput codebase authHTTPClient currentPath numberedArgs = +getUserInput codebase authHTTPClient pp currentProjectRoot numberedArgs = Line.runInputT settings (haskelineCtrlCHandling go) @@ -78,23 +78,7 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = Just a -> pure a go :: Line.InputT IO Input go = do - promptString <- - case preview projectBranchPathPrism currentPath of - Nothing -> pure ((P.green . P.shown) currentPath) - Just (ProjectAndBranch projectId branchId, restPath) -> do - lift (Codebase.runTransaction codebase (Queries.loadProjectAndBranchNames projectId branchId)) <&> \case - -- If the project branch has been deleted from sqlite, just show a borked prompt - Nothing -> P.red "???" - Just (projectName, branchName) -> - P.sep - " " - ( catMaybes - [ Just (prettyProjectAndBranchName (ProjectAndBranch projectName branchName)), - case restPath of - Path.Empty -> Nothing - _ -> (Just . P.green . P.shown) restPath - ] - ) + let promptString = P.prettyProjectPath pp let fullPrompt = P.toANSI 80 (promptString <> fromString prompt) line <- Line.getInputLine fullPrompt case line of @@ -102,7 +86,7 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = Just l -> case words l of [] -> go ws -> do - liftIO (parseInput codebase currentPath numberedArgs IP.patternMap ws) >>= \case + liftIO (parseInput codebase pp currentProjectRoot numberedArgs IP.patternMap ws) >>= \case Left msg -> do -- We still add history that failed to parse so the user can easily reload -- the input and fix it. @@ -126,12 +110,20 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = historyFile = Just ".unisonHistory", autoAddHistory = False } - tabComplete = haskelineTabComplete IP.patternMap codebase authHTTPClient currentPath + tabComplete = haskelineTabComplete IP.patternMap codebase authHTTPClient pp + +loopStateProjectPath :: + Codebase IO Symbol Ann -> + Cli.LoopState -> + IO PP.ProjectPath +loopStateProjectPath codebase loopState = do + let ppIds = NEL.head $ Cli.projectPathStack loopState + ppIds & PP.projectAndBranch_ %%~ \pabIds -> liftIO . Codebase.runTransaction codebase $ ProjectUtils.expectProjectAndBranchByIds pabIds main :: FilePath -> Welcome.Welcome -> - Path.Absolute -> + PP.ProjectPathIds -> Config -> [Either Event Input] -> Runtime.Runtime Symbol -> @@ -140,38 +132,18 @@ main :: Codebase IO Symbol Ann -> Maybe Server.BaseUrl -> UCMVersion -> - (CausalHash -> STM ()) -> - (Path.Absolute -> STM ()) -> + (PP.ProjectPathIds -> IO ()) -> ShouldWatchFiles -> IO () -main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion notifyBranchChange notifyPathChange shouldWatchFiles = Ki.scoped \scope -> do - rootVar <- newEmptyTMVarIO - initialRootCausalHash <- Codebase.runTransaction codebase Operations.expectRootCausalHash +main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do _ <- Ki.fork scope do - root <- Codebase.getRootBranch codebase - atomically do - -- Try putting the root, but if someone else as already written over the root, don't - -- overwrite it. - void $ tryPutTMVar rootVar root + -- 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 -- Start forcing thunks in a background thread. - -- This might be overly aggressive, maybe we should just evaluate the top level but avoid - -- recursive "deep*" things. UnliftIO.concurrently_ - (UnliftIO.evaluate root) + (UnliftIO.evaluate projectRoot) (UnliftIO.evaluate IOSource.typecheckedFile) -- IOSource takes a while to compile, we should start compiling it on startup - let initialState = Cli.loopState0 initialRootCausalHash rootVar initialPath - Ki.fork_ scope do - let loop lastRoot = do - -- This doesn't necessarily notify on _every_ update, but the LSP only needs the - -- most recent version at any given time, so it's fine to skip some intermediate - -- versions. - currentRoot <- atomically do - currentRoot <- readTMVar rootVar - guard $ Just currentRoot /= lastRoot - notifyBranchChange (Branch.headHash currentRoot) - pure (Just currentRoot) - loop currentRoot - loop Nothing + let initialState = Cli.loopState0 ppIds eventQueue <- Q.newIO initialInputsRef <- newIORef $ Welcome.run welcome ++ initialInputs pageOutput <- newIORef True @@ -187,10 +159,14 @@ main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime cod getInput loopState = do currentEcho <- hGetEcho stdin liftIO $ restoreEcho currentEcho + let PP.ProjectAndBranch projId branchId = PP.toProjectAndBranch $ NonEmpty.head loopState.projectPathStack + let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId + pp <- loopStateProjectPath codebase loopState getUserInput codebase authHTTPClient - (loopState ^. #currentPath) + pp + getProjectRoot (loopState ^. #numberedArgs) let loadSourceFile :: Text -> IO Cli.LoadSourceResult loadSourceFile fname = @@ -258,7 +234,8 @@ main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime cod sandboxedRuntime = sbRuntime, nativeRuntime = nRuntime, serverBaseUrl, - ucmVersion + ucmVersion, + isTranscriptTest = False } (onInterrupt, waitForInterrupt) <- buildInterruptHandler @@ -267,6 +244,9 @@ main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime cod -- Handle inputs until @HaltRepl@, staying in the loop on Ctrl+C or synchronous exception. let loop0 :: Cli.LoopState -> IO () loop0 s0 = do + -- It's always possible the previous command changed the branch head, so tell the LSP to check if the current + -- path or project has changed. + lspCheckForChanges (NEL.head $ Cli.projectPathStack s0) let step = do input <- awaitInput s0 (!result, resultState) <- Cli.runCli env s0 (HandleInput.loop input) @@ -284,7 +264,6 @@ main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime cod Text.hPutStrLn stderr ("Encountered exception:\n" <> Text.pack (displayException e)) loop0 s0 Right (Right (result, s1)) -> do - when ((s0 ^. #currentPath) /= (s1 ^. #currentPath :: Path.Absolute)) (atomically . notifyPathChange $ s1 ^. #currentPath) case result of Cli.Success () -> loop0 s1 Cli.Continue -> loop0 s1 diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index bd33365eed..d061f37f54 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -37,14 +37,15 @@ import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import Unison.ABT qualified as ABT import Unison.Auth.Types qualified as Auth import Unison.Builtin.Decls qualified as DD import Unison.Cli.MergeTypes (MergeSourceAndTarget (..)) import Unison.Cli.Pretty -import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.ServantClientUtils qualified as ServantClientUtils import Unison.Codebase.Editor.DisplayObject (DisplayObject (..)) +import Unison.Codebase.Editor.Input (BranchIdG (..)) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output ( CreatedProjectBranchFrom (..), @@ -53,30 +54,25 @@ import Unison.Codebase.Editor.Output Output (..), ShareError (..), TestReportStats (CachedTests, NewlyComputed), + TodoOutput, UndoFailureReason (CantUndoPastMerge, CantUndoPastStart), + todoOutputIsEmpty, ) import Unison.Codebase.Editor.Output qualified as E import Unison.Codebase.Editor.Output.BranchDiff qualified as OBD import Unison.Codebase.Editor.Output.PushPull qualified as PushPull -import Unison.Codebase.Editor.RemoteRepo (ShareUserHandle (..), WriteRemoteNamespace (..), WriteShareRemoteNamespace (..)) -import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.StructuredArgument qualified as SA -import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck (IntegrityResult (..), prettyPrintIntegrityErrors) -import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path qualified as Path -import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv -import Unison.Codebase.TermEdit qualified as TermEdit -import Unison.Codebase.TypeEdit qualified as TypeEdit -import Unison.CommandLine (bigproblem, note, tip) import Unison.CommandLine.FZFResolvers qualified as FZFResolvers +import Unison.CommandLine.Helpers (bigproblem, note, tip) import Unison.CommandLine.InputPattern (InputPattern) import Unison.CommandLine.InputPatterns (makeExample') import Unison.CommandLine.InputPatterns qualified as IP @@ -87,12 +83,12 @@ import Unison.DataDeclaration qualified as DD import Unison.Hash qualified as Hash import Unison.Hash32 (Hash32) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency as LD +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..)) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment -import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (..)) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names @@ -113,15 +109,15 @@ import Unison.PrintError renderCompilerBug, ) import Unison.Project (ProjectAndBranch (..)) -import Unison.Reference (Reference, TermReferenceId) +import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent +import Unison.ReferentPrime qualified as Referent import Unison.Result qualified as Result import Unison.Server.Backend (ShallowListEntry (..), TypeEntry (..)) import Unison.Server.Backend qualified as Backend -import Unison.Server.SearchResult' qualified as SR' +import Unison.Server.SearchResultPrime qualified as SR' import Unison.Share.Sync qualified as Share import Unison.Share.Sync.Types (CodeserverTransportError (..)) import Unison.Sync.Types qualified as Share @@ -137,7 +133,6 @@ import Unison.Syntax.NamePrinter prettyReference, prettyReferent, prettyShortHash, - styleHashQualified, ) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TermPrinter qualified as TermPrinter @@ -146,6 +141,7 @@ import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (Defns (..)) import Unison.Util.List qualified as List import Unison.Util.Monoid (intercalateMap) import Unison.Util.Monoid qualified as Monoid @@ -174,7 +170,7 @@ renderFileName dir = P.group . P.blue . fromString <$> shortenDirectory dir notifyNumbered :: NumberedOutput -> (Pretty, NumberedArgs) notifyNumbered = \case ShowDiffNamespace oldPrefix newPrefix ppe diffOutput -> - showDiffNamespace ShowNumbers ppe oldPrefix newPrefix diffOutput + showDiffNamespace ShowNumbers ppe (either BranchAtSCH BranchAtProjectPath oldPrefix) (either BranchAtSCH BranchAtProjectPath newPrefix) diffOutput ShowDiffAfterDeleteDefinitions ppe diff -> first ( \p -> @@ -228,12 +224,14 @@ notifyNumbered = \case <> "to run the tests." <> "Or you can use" <> IP.makeExample' IP.undo - <> " or" - <> IP.makeExample' IP.viewReflog - <> " to undo the results of this merge." + <> " or use a hash from " + <> IP.makeExample' IP.branchReflog + <> " with " + <> IP.makeExample' IP.reset + <> " to reset to a previous state." ] ) - (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) + (showDiffNamespace ShowNumbers ppe (BranchAtProjectPath destAbs) (BranchAtProjectPath destAbs) diffOutput) ShowDiffAfterMergePropagate dest' destAbs patchPath' ppe diffOutput -> first ( \p -> @@ -255,12 +253,12 @@ notifyNumbered = \case <> "to run the tests." <> "Or you can use" <> IP.makeExample' IP.undo - <> " or" - <> IP.makeExample' IP.viewReflog + <> " or use a hash from " + <> IP.makeExample' IP.branchReflog <> " to undo the results of this merge." ] ) - (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) + (showDiffNamespace ShowNumbers ppe (BranchAtProjectPath destAbs) (BranchAtProjectPath destAbs) diffOutput) ShowDiffAfterMergePreview dest' destAbs ppe diffOutput -> first ( \p -> @@ -270,7 +268,7 @@ notifyNumbered = \case p ] ) - (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) + (showDiffNamespace ShowNumbers ppe (BranchAtProjectPath destAbs) (BranchAtProjectPath destAbs) diffOutput) ShowDiffAfterUndo ppe diffOutput -> first (\p -> P.lines ["Here are the changes I undid", "", p]) @@ -310,7 +308,30 @@ notifyNumbered = \case ] ) (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) - TodoOutput names todo -> todoOutput names todo + TestResults stats ppe _showSuccess _showFailures oksUnsorted failsUnsorted -> + let oks = Name.sortByText (HQ.toText . fst) [(name r, msgs) | (r, msgs) <- Map.toList oksUnsorted] + fails = Name.sortByText (HQ.toText . fst) [(name r, msgs) | (r, msgs) <- Map.toList failsUnsorted] + name r = PPE.termName ppe (Referent.fromTermReferenceId r) + in ( case stats of + CachedTests 0 _ -> P.callout "😶" $ "No tests to run." + CachedTests n n' | n == n' -> P.lines [cache, "", displayTestResults True oks fails] + CachedTests _n m -> + if m == 0 + then "✅ " + else + P.indentN 2 $ + P.lines ["", cache, "", displayTestResults False oks fails, "", "✅ "] + NewlyComputed -> + P.lines + [ " " <> P.bold "New test results:", + "", + displayTestResults True oks fails + ], + fmap (SA.HashQualified . fst) $ oks <> fails + ) + where + cache = P.bold "Cached test results " <> "(`help testcache` to learn more)" + Output'Todo todoOutput -> runNumbered (handleTodoOutput todoOutput) CantDeleteDefinitions ppeDecl endangerments -> ( P.warnCallout $ P.lines @@ -452,7 +473,7 @@ notifyNumbered = \case ) where switch = IP.makeExample IP.projectSwitch - AmbiguousReset sourceOfAmbiguity (ProjectAndBranch pn0 bn0, path) (ProjectAndBranch currentProject branch) -> + AmbiguousReset sourceOfAmbiguity (ProjectAndBranch _pn0 _bn0, path) (ProjectAndBranch currentProject branch) -> ( P.wrap ( openingLine <> prettyProjectAndBranchName (ProjectAndBranch currentProject branch) @@ -492,10 +513,10 @@ notifyNumbered = \case E.AmbiguousReset'Target -> \xs -> "" : xs reset = IP.makeExample IP.reset relPath0 = prettyPath path - absPath0 = review ProjectUtils.projectBranchPathPrism (ProjectAndBranch (pn0 ^. #projectId) (bn0 ^. #branchId), path) + absPath0 = Path.Absolute path ListNamespaceDependencies _ppe _path Empty -> ("This namespace has no external dependencies.", mempty) ListNamespaceDependencies ppe path' externalDependencies -> - ( P.column2Header (P.hiBlack "External dependency") ("Dependents in " <> prettyAbsolute path') $ + ( P.column2Header (P.hiBlack "External dependency") ("Dependents in " <> prettyProjectPath path') $ List.intersperse spacer (externalDepsTable externalDependencies), numberedArgs ) @@ -536,16 +557,17 @@ notifyNumbered = \case & Set.toList & fmap (\name -> formatNum (getNameNumber name) <> prettyName name) & P.lines + ShowProjectBranchReflog now moreToShow entries -> displayProjectBranchReflogEntries now moreToShow entries where - absPathToBranchId = Right + absPathToBranchId = BranchAtPath undoTip :: P.Pretty P.ColorText undoTip = tip $ "You can use" <> IP.makeExample' IP.undo - <> "or" - <> IP.makeExample' IP.viewReflog + <> " or use a hash from " + <> IP.makeExample' IP.branchReflog <> "to undo this change." notifyUser :: FilePath -> Output -> IO Pretty @@ -581,13 +603,13 @@ notifyUser dir = \case pure . P.warnCallout $ "The namespace " - <> prettyBranchId p0 + <> either prettySCH prettyProjectPath p0 <> " is empty. Was there a typo?" ps -> pure . P.warnCallout $ "The namespaces " - <> P.commas (prettyBranchId <$> ps) + <> P.commas (either prettySCH prettyProjectPath <$> ps) <> " are empty. Was there a typo?" LoadPullRequest baseNS headNS basePath headPath mergedPath squashedPath -> pure $ @@ -641,29 +663,6 @@ notifyUser dir = \case OutputRewrittenFile dest vs -> displayOutputRewrittenFile dest vs DisplayRendered outputLoc pp -> displayRendered outputLoc pp - TestResults stats ppe _showSuccess _showFailures oks fails -> case stats of - CachedTests 0 _ -> pure . P.callout "😶" $ "No tests to run." - CachedTests n n' - | n == n' -> - pure $ - P.lines [cache, "", displayTestResults True ppe oks fails] - CachedTests _n m -> - pure $ - if m == 0 - then "✅ " - else - P.indentN 2 $ - P.lines ["", cache, "", displayTestResults False ppe oks fails, "", "✅ "] - NewlyComputed -> do - clearCurrentLine - pure $ - P.lines - [ " " <> P.bold "New test results:", - "", - displayTestResults True ppe oks fails - ] - where - cache = P.bold "Cached test results " <> "(`help testcache` to learn more)" TestIncrementalOutputStart ppe (n, total) r -> do putPretty' $ P.shown (total - n) @@ -803,7 +802,7 @@ notifyUser dir = \case prettyProjectAndBranchName projectAndBranch <> "is empty. There is nothing to push." CreatedNewBranch path -> pure $ - "☝️ The namespace " <> prettyAbsoluteStripProject path <> " is empty." + "☝️ The namespace " <> prettyAbsolute path <> " is empty." -- RenameOutput rootPath oldName newName r -> do -- nameChange "rename" "renamed" oldName newName r -- AliasOutput rootPath existingName newName r -> do @@ -821,9 +820,13 @@ notifyUser dir = \case DeleteEverythingConfirmation -> pure . P.warnCallout . P.lines $ [ "Are you sure you want to clear away everything?", - "You could use " - <> IP.makeExample' IP.projectCreate - <> " to switch to a new project instead." + P.wrap + ( "You could use " + <> IP.makeExample' IP.projectCreate + <> " to switch to a new project instead," + <> " or delete the current branch with " + <> IP.makeExample' IP.deleteBranch + ) ] DeleteBranchConfirmation _uniqueDeletions -> error "todo" -- let @@ -1202,7 +1205,7 @@ notifyUser dir = \case ] where name :: Name - name = Path.unsafeToName' (HQ'.toName (Path.unsplitHQ' p)) + name = HQ'.toName $ Path.nameFromHQSplit' p qualifyTerm :: Referent -> Pretty qualifyTerm = P.syntaxToColor . prettyNamedReferent hashLen name qualifyType :: Reference -> Pretty @@ -1287,8 +1290,8 @@ notifyUser dir = \case "to make an old namespace accessible again," ), (mempty, mempty), - ( IP.makeExample IP.resetRoot [prettySCH prevSCH], - "to reset the root namespace and its history to that of the specified" + ( IP.makeExample IP.reset [prettySCH prevSCH], + "to reset the current namespace and its history to that of the specified" <> "namespace." ) ] @@ -1331,9 +1334,9 @@ notifyUser dir = \case MergeAlreadyUpToDate src dest -> pure . P.callout "😶" $ P.wrap $ - either prettyPath' prettyProjectAndBranchName dest + prettyBranchRelativePath dest <> "was already up-to-date with" - <> P.group (either prettyPath' prettyProjectAndBranchName src <> ".") + <> P.group (prettyBranchRelativePath src <> ".") MergeAlreadyUpToDate2 aliceAndBob -> pure . P.callout "😶" $ P.wrap $ @@ -1403,6 +1406,7 @@ notifyUser dir = \case <> "the same on both branches, or making neither of them a builtin, and then try the merge again." ) ] + -- Note [ConstructorAliasMessage] If you change this, also change the other similar one MergeConstructorAlias aliceOrBob typeName conName1 conName2 -> pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", @@ -1418,6 +1422,7 @@ notifyUser dir = \case "", P.wrap "Please delete all but one name for each constructor, and then try merging again." ] + -- Note [DefnsInLibMessage] If you change this, also change the other similar one MergeDefnsInLib aliceOrBob -> pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", @@ -1430,6 +1435,7 @@ notifyUser dir = \case "", P.wrap "Please move or remove it and then try merging again." ] + -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one MergeMissingConstructorName aliceOrBob name -> pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", @@ -1448,6 +1454,7 @@ notifyUser dir = \case <> IP.makeExample IP.aliasTerm ["", prettyName name <> "."] <> "to give names to each unnamed constructor, and then try the merge again." ] + -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one MergeNestedDeclAlias aliceOrBob shorterName longerName -> pure . P.wrap $ "On" @@ -1458,6 +1465,7 @@ notifyUser dir = \case <> P.group (prettyName shorterName <> ".") <> "I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or" <> "delete one copy, and then try merging again." + -- Note [StrayConstructorMessage] If you change this, also change the other similar one MergeStrayConstructor aliceOrBob name -> pure . P.lines $ [ P.wrap $ @@ -1478,13 +1486,11 @@ notifyUser dir = \case PreviewMergeAlreadyUpToDate src dest -> pure . P.callout "😶" $ P.wrap $ - prettyNamespaceKey dest + prettyProjectPath dest <> "is already up-to-date with" - <> P.group (prettyNamespaceKey src <> ".") + <> P.group (prettyProjectPath src) DumpNumberedArgs schLength args -> pure . P.numberedList $ fmap (P.text . IP.formatStructuredArgument (pure schLength)) args - NoConflictsOrEdits -> - pure (P.okCallout "No conflicts or edits in progress.") HelpMessage pat -> pure $ IP.showPatternHelp pat NoOp -> pure $ P.string "I didn't make any changes." DumpBitBooster head map -> @@ -1537,11 +1543,6 @@ notifyUser dir = \case <> ( terms <&> \(n, r) -> prettyHashQualified' (HQ'.take hqLength . HQ'.fromNamedReference n $ Reference.DerivedId r) ) - RefusedToPush pushBehavior path -> - (pure . P.warnCallout) case pushBehavior of - PushBehavior.ForcePush -> error "impossible: refused to push due to ForcePush?" - PushBehavior.RequireEmpty -> expectedEmptyPushDest path - PushBehavior.RequireNonEmpty -> expectedNonEmptyPushDest path GistCreated remoteNamespace -> pure $ P.lines @@ -1603,10 +1604,7 @@ notifyUser dir = \case PrintVersion ucmVersion -> pure (P.text ucmVersion) ShareError shareError -> pure (prettyShareError shareError) ViewOnShare shareRef -> - pure $ - "View it here: " <> case shareRef of - Left repoPath -> prettyShareLink repoPath - Right branchInfo -> prettyRemoteBranchInfo branchInfo + pure $ "View it here: " <> prettyRemoteBranchInfo shareRef IntegrityCheck result -> pure $ case result of NoIntegrityErrors -> "🎉 No issues detected 🎉" IntegrityErrorDetected ns -> prettyPrintIntegrityErrors ns @@ -1650,6 +1648,16 @@ notifyUser dir = \case else "" in (isCompleteTxt, P.string (Completion.replacement comp)) ) + DisplayDebugLSPNameCompletions completions -> + pure $ + P.columnNHeader + ["Matching Path", "Name", "Hash"] + ( completions <&> \(pathText, fqn, ld) -> + let ldRef = case ld of + LD.TermReferent ref -> prettyReferent 10 ref + LD.TypeReference ref -> prettyReference 10 ref + in [P.text pathText, prettyName fqn, P.syntaxToColor ldRef] + ) DebugDisplayFuzzyOptions argDesc fuzzyOptions -> pure $ P.lines @@ -2072,16 +2080,6 @@ notifyUser dir = \case <> P.group (P.text (NameSegment.toEscapedText new) <> ",") <> "and removed" <> P.group (P.text (NameSegment.toEscapedText old) <> ".") - LooseCodePushDeprecated -> - pure . P.warnCallout $ - P.lines $ - [ P.wrap $ "Unison Share's projects are now the new preferred way to store code, and storing code outside of a project has been deprecated.", - "", - P.wrap $ "Learn how to convert existing code into a project using this guide: ", - "https://www.unison-lang.org/docs/tooling/projects-library-migration/", - "", - "Your non-project code is still available to pull from Share, and you can pull it into a local namespace using `pull myhandle.public`" - ] MergeFailure path aliceAndBob temp -> pure $ P.lines $ @@ -2136,7 +2134,7 @@ notifyUser dir = \case <> P.group (IP.makeExample IP.libInstallInputPattern [prettyProjectAndBranchName libdep] <> ".") PullIntoMissingBranch source (ProjectAndBranch maybeTargetProject targetBranch) -> pure . P.wrap $ - "I think you're wanting to merge" + "I think you want to merge" <> sourcePretty <> "into the" <> targetPretty @@ -2153,40 +2151,27 @@ notifyUser dir = \case Just targetProject -> prettyProjectAndBranchName (ProjectAndBranch targetProject targetBranch) NoMergeInProgress -> pure . P.wrap $ "It doesn't look like there's a merge in progress." - -expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty -expectedEmptyPushDest namespace = - P.lines - [ "The remote namespace " <> prettyWriteRemoteNamespace (absurd <$> namespace) <> " is not empty.", - "", - "Did you mean to use " <> IP.makeExample' IP.push <> " instead?" - ] - -expectedNonEmptyPushDest :: WriteRemoteNamespace Void -> Pretty -expectedNonEmptyPushDest namespace = - P.lines - [ P.wrap ("The remote namespace " <> prettyWriteRemoteNamespace (absurd <$> namespace) <> " is empty."), - "", - P.wrap ("Did you mean to use " <> IP.makeExample' IP.pushCreate <> " instead?") - ] + Output'DebugSynhashTerm ref synhash filename -> + pure $ + "Hash: " + <> P.syntaxToColor (prettyReference 120 ref) + <> P.newline + <> "Synhash: " + <> prettyHash synhash + <> P.newline + <> "Synhash tokens: " + <> P.text filename prettyShareError :: ShareError -> Pretty prettyShareError = P.fatalCallout . \case - ShareErrorCheckAndSetPush err -> prettyCheckAndSetPushError err ShareErrorDownloadEntities err -> prettyDownloadEntitiesError err - ShareErrorFastForwardPush err -> prettyFastForwardPushError err ShareErrorGetCausalHashByPath err -> prettyGetCausalHashByPathError err ShareErrorPull err -> prettyPullError err ShareErrorTransport err -> prettyTransportError err ShareErrorUploadEntities err -> prettyUploadEntitiesError err ShareExpectedSquashedHead -> "The server failed to provide a squashed branch head when requested. Please report this as a bug to the Unison team." -prettyCheckAndSetPushError :: Share.CheckAndSetPushError -> Pretty -prettyCheckAndSetPushError = \case - Share.CheckAndSetPushError'UpdatePath repoInfo err -> prettyUpdatePathError repoInfo err - Share.CheckAndSetPushError'UploadEntities err -> prettyUploadEntitiesError err - prettyDownloadEntitiesError :: Share.DownloadEntitiesError -> Pretty prettyDownloadEntitiesError = \case Share.DownloadEntitiesNoReadPermission repoInfo -> noReadPermissionForRepo repoInfo @@ -2195,27 +2180,6 @@ prettyDownloadEntitiesError = \case Share.DownloadEntitiesProjectNotFound project -> shareProjectNotFound project Share.DownloadEntitiesEntityValidationFailure err -> prettyEntityValidationFailure err -prettyFastForwardPathError :: Share.Path -> Share.FastForwardPathError -> Pretty -prettyFastForwardPathError path = \case - Share.FastForwardPathError'InvalidParentage Share.InvalidParentage {child, parent} -> - P.lines - [ "The server detected an error in the history being pushed, please report this as a bug in ucm.", - "The history in question is the hash: " <> prettyHash32 child <> " with the ancestor: " <> prettyHash32 parent - ] - Share.FastForwardPathError'InvalidRepoInfo err repoInfo -> invalidRepoInfo err repoInfo - Share.FastForwardPathError'MissingDependencies dependencies -> needDependencies dependencies - Share.FastForwardPathError'NoHistory -> expectedNonEmptyPushDest (sharePathToWriteRemotePathShare path) - Share.FastForwardPathError'NoWritePermission path -> noWritePermissionForPath path - Share.FastForwardPathError'NotFastForward _hashJwt -> notFastForward path - Share.FastForwardPathError'UserNotFound -> shareUserNotFound (Share.pathRepoInfo path) - -prettyFastForwardPushError :: Share.FastForwardPushError -> Pretty -prettyFastForwardPushError = \case - Share.FastForwardPushError'FastForwardPath path err -> prettyFastForwardPathError path err - Share.FastForwardPushError'GetCausalHash err -> prettyGetCausalHashByPathError err - Share.FastForwardPushError'NotFastForward path -> notFastForward path - Share.FastForwardPushError'UploadEntities err -> prettyUploadEntitiesError err - prettyGetCausalHashByPathError :: Share.GetCausalHashByPathError -> Pretty prettyGetCausalHashByPathError = \case Share.GetCausalHashByPathErrorNoReadPermission sharePath -> noReadPermissionForPath sharePath @@ -2229,21 +2193,6 @@ prettyPullError = \case Share.PullError'NoHistoryAtPath sharePath -> P.wrap $ P.text "The server didn't find anything at" <> prettySharePath sharePath -prettyUpdatePathError :: Share.RepoInfo -> Share.UpdatePathError -> Pretty -prettyUpdatePathError repoInfo = \case - Share.UpdatePathError'HashMismatch Share.HashMismatch {path = sharePath, expectedHash, actualHash} -> - case (expectedHash, actualHash) of - (Nothing, Just _) -> expectedEmptyPushDest (sharePathToWriteRemotePathShare sharePath) - _ -> - P.wrap $ - P.text "It looks like someone modified" - <> prettySharePath sharePath - <> P.text "an instant before you. Pull and try again? 🤞" - Share.UpdatePathError'InvalidRepoInfo err repoInfo -> invalidRepoInfo err repoInfo - Share.UpdatePathError'MissingDependencies dependencies -> needDependencies dependencies - Share.UpdatePathError'NoWritePermission path -> noWritePermissionForPath path - Share.UpdatePathError'UserNotFound -> shareUserNotFound repoInfo - prettyUploadEntitiesError :: Share.UploadEntitiesError -> Pretty prettyUploadEntitiesError = \case Share.UploadEntitiesError'EntityValidationFailure validationFailureErr -> prettyEntityValidationFailure validationFailureErr @@ -2441,17 +2390,6 @@ shareUserNotFound :: Share.RepoInfo -> Pretty shareUserNotFound repoInfo = P.wrap ("User" <> prettyRepoInfo repoInfo <> "does not exist.") -sharePathToWriteRemotePathShare :: Share.Path -> WriteRemoteNamespace void -sharePathToWriteRemotePathShare sharePath = - -- Recover the original WriteRemotePath from the information in the error, which is thrown from generic share - -- client code that doesn't know about WriteRemotePath - WriteRemoteNamespaceShare - WriteShareRemoteNamespace - { server = RemoteRepo.DefaultCodeserver, - repo = ShareUserHandle $ Share.unRepoInfo (Share.pathRepoInfo sharePath), - path = Path.fromList (coerce @[Text] @[NameSegment] (Share.pathCodebasePath sharePath)) - } - formatMissingStuff :: (Show tm, Show typ) => [(HQ.HashQualified Name, tm)] -> @@ -2540,38 +2478,37 @@ displayRendered outputLoc pp = displayTestResults :: Bool -> -- whether to show the tip - PPE.PrettyPrintEnv -> - [(TermReferenceId, Text)] -> - [(TermReferenceId, Text)] -> + [(HQ.HashQualified Name, [Text])] -> + [(HQ.HashQualified Name, [Text])] -> Pretty -displayTestResults showTip ppe oksUnsorted failsUnsorted = - let oks = Name.sortByText fst [(name r, msg) | (r, msg) <- oksUnsorted] - fails = Name.sortByText fst [(name r, msg) | (r, msg) <- failsUnsorted] - name r = HQ.toText $ PPE.termName ppe (Referent.fromTermReferenceId r) +displayTestResults showTip oks fails = + let name = P.text . HQ.toText okMsg = if null oks then mempty - else P.column2 [(P.green "◉ " <> P.text r, " " <> P.green (P.text msg)) | (r, msg) <- oks] + else + P.indentN 2 $ + P.numberedColumn2ListFrom 0 [(name r, P.lines $ P.green . (" ◉ " <>) . P.text <$> msgs) | (r, msgs) <- oks] okSummary = if null oks then mempty - else "✅ " <> P.bold (P.num (length oks)) <> P.green " test(s) passing" + else "✅ " <> P.bold (P.num (sum $ fmap (length . snd) oks)) <> P.green " test(s) passing" failMsg = if null fails then mempty - else P.column2 [(P.red "✗ " <> P.text r, " " <> P.red (P.text msg)) | (r, msg) <- fails] + else + P.indentN 2 $ + P.numberedColumn2ListFrom + (length oks) + [(name r, P.lines $ P.red . (" ✗ " <>) . P.text <$> msgs) | (r, msgs) <- fails] failSummary = if null fails then mempty - else "🚫 " <> P.bold (P.num (length fails)) <> P.red " test(s) failing" + else "🚫 " <> P.bold (P.num (sum $ fmap (length . snd) fails)) <> P.red " test(s) failing" tipMsg = if not showTip || (null oks && null fails) then mempty - else - tip $ - "Use " - <> P.blue ("view " <> P.text (fst $ head (fails ++ oks))) - <> "to view the source of a test." + else tip $ "Use " <> P.blue "view 1" <> "to view the source of a test." in if null oks && null fails then "😶 No tests available." else @@ -2592,20 +2529,20 @@ unsafePrettyTermResultSig' ppe = \case head (TypePrinter.prettySignaturesCT ppe [(r, name, typ)]) _ -> error "Don't pass Nothing" -renderNameConflicts :: PPE.PrettyPrintEnv -> Names -> Numbered Pretty -renderNameConflicts ppe conflictedNames = do +renderNameConflicts :: Int -> Names -> Numbered Pretty +renderNameConflicts hashLen conflictedNames = do let conflictedTypeNames :: Map Name [HQ.HashQualified Name] conflictedTypeNames = conflictedNames & Names.types & R.domain - & fmap (foldMap (pure @[] . PPE.typeName ppe)) + & Map.mapWithKey \name -> map (HQ.take hashLen . HQ.HashQualified name . Reference.toShortHash) . Set.toList let conflictedTermNames :: Map Name [HQ.HashQualified Name] conflictedTermNames = conflictedNames & Names.terms & R.domain - & fmap (foldMap (pure @[] . PPE.termName ppe)) + & Map.mapWithKey \name -> map (HQ.take hashLen . HQ.HashQualified name . Referent.toShortHash) . Set.toList let allConflictedNames :: [Name] allConflictedNames = Set.toList (Map.keysSet conflictedTermNames <> Map.keysSet conflictedTypeNames) prettyConflictedTypes <- showConflictedNames "type" conflictedTypeNames @@ -2616,8 +2553,7 @@ renderNameConflicts ppe conflictedNames = do [ prettyConflictedTypes, prettyConflictedTerms, tip $ - "This occurs when merging branches that both independently introduce the same name." - <> "Use " + "Use " <> makeExample' ( if (not . null) conflictedTypeNames then IP.renameType @@ -2635,86 +2571,30 @@ renderNameConflicts ppe conflictedNames = do showConflictedNames :: Pretty -> Map Name [HQ.HashQualified Name] -> Numbered Pretty showConflictedNames thingKind conflictedNames = P.lines <$> do - for (Map.toList conflictedNames) $ \(name, hashes) -> do + for (Map.toList conflictedNames) \(name, hashes) -> do prettyConflicts <- for hashes \hash -> do n <- addNumberedArg $ SA.HashQualified hash pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash) - pure . P.wrap $ - ( "The " - <> thingKind - <> " " - <> P.green (prettyName name) - <> " has conflicting definitions:" - ) - `P.hang` P.lines prettyConflicts - -renderEditConflicts :: - PPE.PrettyPrintEnv -> Patch -> Numbered Pretty -renderEditConflicts ppe Patch {..} = do - formattedConflicts <- for editConflicts formatConflict - pure . Monoid.unlessM (null editConflicts) . P.callout "❓" . P.sep "\n\n" $ - [ P.wrap $ - "These" - <> P.bold "definitions were edited differently" - <> "in namespaces that have been merged into this one." - <> "You'll have to tell me what to use as the new definition:", - P.indentN 2 (P.lines formattedConflicts) - -- , tip $ "Use " <> makeExample IP.resolve [name (head editConflicts), " "] <> " to pick a replacement." -- todo: eventually something with `edit` - ] - where - -- todo: could possibly simplify all of this, but today is a copy/paste day. - editConflicts :: [Either (Reference, Set TypeEdit.TypeEdit) (Reference, Set TermEdit.TermEdit)] - editConflicts = - (fmap Left . Map.toList . R.toMultimap . R.filterManyDom $ _typeEdits) - <> (fmap Right . Map.toList . R.toMultimap . R.filterManyDom $ _termEdits) - numberedHQName :: HQ.HashQualified Name -> Numbered Pretty - numberedHQName hqName = do - n <- addNumberedArg $ SA.HashQualified hqName - pure $ formatNum n <> styleHashQualified P.bold hqName - formatTypeEdits :: - (Reference, Set TypeEdit.TypeEdit) -> - Numbered Pretty - formatTypeEdits (r, toList -> es) = do - replacedType <- numberedHQName (PPE.typeName ppe r) - replacements <- for [PPE.typeName ppe r | TypeEdit.Replace r <- es] numberedHQName - pure . P.wrap $ - "The type" - <> replacedType - <> "was" - <> ( if TypeEdit.Deprecate `elem` es - then "deprecated and also replaced with" - else "replaced with" - ) - `P.hang` P.lines replacements - formatTermEdits :: - (Reference.TermReference, Set TermEdit.TermEdit) -> - Numbered Pretty - formatTermEdits (r, toList -> es) = do - replacedTerm <- numberedHQName (PPE.termName ppe (Referent.Ref r)) - replacements <- for [PPE.termName ppe (Referent.Ref r) | TermEdit.Replace r _ <- es] numberedHQName - pure . P.wrap $ - "The term" - <> replacedTerm - <> "was" - <> ( if TermEdit.Deprecate `elem` es - then "deprecated and also replaced with" - else "replaced with" - ) - `P.hang` P.lines replacements - formatConflict :: - Either - (Reference, Set TypeEdit.TypeEdit) - (Reference.TermReference, Set TermEdit.TermEdit) -> - Numbered Pretty - formatConflict = either formatTypeEdits formatTermEdits + pure $ + P.wrap + ( "The " + <> thingKind + <> " " + <> P.green (prettyName name) + <> " has conflicting definitions:" + ) + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines prettyConflicts) type Numbered = State.State (Int, Seq.Seq StructuredArgument) addNumberedArg :: StructuredArgument -> Numbered Int addNumberedArg s = do (n, args) <- State.get - State.put (n + 1, args Seq.|> s) - pure $ (n + 1) + let !n' = n + 1 + State.put (n', args Seq.|> s) + pure n' formatNum :: Int -> Pretty formatNum n = P.string (show n <> ". ") @@ -2724,90 +2604,212 @@ runNumbered m = let (a, (_, args)) = State.runState m (0, mempty) in (a, Foldable.toList args) -todoOutput :: (Var v) => PPED.PrettyPrintEnvDecl -> TO.TodoOutput v a -> (Pretty, NumberedArgs) -todoOutput ppe todo = runNumbered do - conflicts <- todoConflicts - edits <- todoEdits - pure (conflicts <> edits) - where - ppeu = PPED.unsuffixifiedPPE ppe - ppes = PPED.suffixifiedPPE ppe - (frontierTerms, frontierTypes) = TO.todoFrontier todo - (dirtyTerms, dirtyTypes) = TO.todoFrontierDependents todo - corruptTerms = - [(PPE.termName ppeu (Referent.Ref r), r) | (r, Nothing) <- frontierTerms] - corruptTypes = - [(PPE.typeName ppeu r, r) | (r, MissingObject _) <- frontierTypes] - goodTerms ts = - [(Referent.Ref r, PPE.termName ppeu (Referent.Ref r), typ) | (r, Just typ) <- ts] - todoConflicts :: Numbered Pretty - todoConflicts = do - if TO.noConflicts todo - then pure mempty - else do - editConflicts <- renderEditConflicts ppeu (TO.editConflicts todo) - nameConflicts <- renderNameConflicts ppeu conflictedNames - pure $ P.lines . P.nonEmpty $ [editConflicts, nameConflicts] - where - -- If a conflict is both an edit and a name conflict, we show it in the edit - -- conflicts section - conflictedNames :: Names - conflictedNames = removeEditConflicts (TO.editConflicts todo) (TO.nameConflicts todo) - -- e.g. `foo#a` has been independently updated to `foo#b` and `foo#c`. - -- This means there will be a name conflict: - -- foo -> #b - -- foo -> #c - -- as well as an edit conflict: - -- #a -> #b - -- #a -> #c - -- We want to hide/ignore the name conflicts that are also targets of an - -- edit conflict, so that the edit conflict will be dealt with first. - -- For example, if hash `h` has multiple edit targets { #x, #y, #z, ...}, - -- we'll temporarily remove name conflicts pointing to { #x, #y, #z, ...}. - removeEditConflicts :: Patch -> Names -> Names - removeEditConflicts Patch {..} Names {..} = Names terms' types' - where - terms' = R.filterRan (`Set.notMember` conflictedTermEditTargets) terms - types' = R.filterRan (`Set.notMember` conflictedTypeEditTargets) types - conflictedTypeEditTargets :: Set Reference - conflictedTypeEditTargets = - Set.fromList $ toList (R.ran typeEditConflicts) >>= TypeEdit.references - conflictedTermEditTargets :: Set Referent.Referent - conflictedTermEditTargets = - Set.fromList . fmap Referent.Ref $ - toList (R.ran termEditConflicts) >>= TermEdit.references - typeEditConflicts = R.filterDom (`R.manyDom` _typeEdits) _typeEdits - termEditConflicts = R.filterDom (`R.manyDom` _termEdits) _termEdits - - todoEdits :: Numbered Pretty - todoEdits = do - numberedTypes <- for (unscore <$> dirtyTypes) \(ref, displayObj) -> do - n <- addNumberedArg . SA.HashQualified $ PPE.typeName ppeu ref - pure $ formatNum n <> prettyDeclPair ppeu (ref, displayObj) - let filteredTerms = goodTerms (unscore <$> dirtyTerms) - termNumbers <- for filteredTerms \(ref, _, _) -> do - n <- addNumberedArg . SA.HashQualified $ PPE.termName ppeu ref - pure $ formatNum n - let formattedTerms = TypePrinter.prettySignaturesCT ppes filteredTerms - numberedTerms = zipWith (<>) termNumbers formattedTerms - pure $ - Monoid.unlessM (TO.noEdits todo) . P.callout "🚧" . P.sep "\n\n" . P.nonEmpty $ - [ P.wrap - ( "The namespace has" - <> fromString (show (TO.todoScore todo)) - <> "transitive dependent(s) left to upgrade." - <> "Your edit frontier is the dependents of these definitions:" - ), - P.indentN 2 . P.lines $ - ( (prettyDeclPair ppeu <$> toList frontierTypes) - ++ TypePrinter.prettySignaturesCT ppes (goodTerms frontierTerms) - ), - P.wrap "I recommend working on them in the following order:", - P.lines $ numberedTypes ++ numberedTerms, - formatMissingStuff corruptTerms corruptTypes - ] - unscore :: (a, b, c) -> (b, c) - unscore (_score, b, c) = (b, c) +handleTodoOutput :: TodoOutput -> Numbered Pretty +handleTodoOutput todo + | todoOutputIsEmpty todo = pure "You have no pending todo items. Good work! ✅" + | otherwise = do + prettyDependentsOfTodo <- do + if Set.null todo.dependentsOfTodo + then pure mempty + else do + terms <- + for (Set.toList todo.dependentsOfTodo) \term -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.idToShortHash term))) + let name = + term + & Referent.fromTermReferenceId + & PPE.termName todo.ppe.suffixifiedPPE + & prettyHashQualified + & P.syntaxToColor + pure (formatNum n <> name) + pure $ + P.wrap "These terms call `todo`:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines terms) + + prettyDirectTermDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.terms + then pure mempty + else do + terms <- + for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) + pure $ + P.wrap "These terms do not have any names in the current namespace:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines terms) + + prettyDirectTypeDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.types + then pure mempty + else do + types <- + for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) + pure $ + P.wrap "These types do not have any names in the current namespace:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines types) + + prettyConflicts <- + if todo.nameConflicts == mempty + then pure mempty + else renderNameConflicts todo.hashLen todo.nameConflicts + + let prettyDefnsInLib = + if todo.defnsInLib + then + P.wrap $ + -- Note [DefnsInLibMessage] If you change this, also change the other similar one + "There's a type or term at the top level of the `lib` namespace, where I only expect to find" + <> "subnamespaces representing library dependencies. Please move or remove it." + else mempty + + prettyConstructorAliases <- + let -- We want to filter out constructor aliases whose types are part of a "nested decl alias" problem, because + -- otherwise we'd essentially be reporting those issues twice. + -- + -- That is, if we have two nested aliases like + -- + -- Foo = #XYZ + -- Foo.Bar = #XYZ#0 + -- + -- Foo.inner.Alias = #XYZ + -- Foo.inner.Alias.Constructor = #XYZ#0 + -- + -- then we'd prefer to say "oh no Foo and Foo.inner.Alias are aliases" but *not* additionally say "oh no + -- Foo.Bar and Foo.inner.Alias.Constructor are aliases". + notNestedDeclAlias (typeName, _, _) = + foldr + (\(short, long) acc -> typeName /= short && typeName /= long && acc) + True + todo.incoherentDeclReasons.nestedDeclAliases + in case filter notNestedDeclAlias todo.incoherentDeclReasons.constructorAliases of + [] -> pure mempty + aliases -> do + things <- + for aliases \(typeName, conName1, conName2) -> do + n1 <- addNumberedArg (SA.Name conName1) + n2 <- addNumberedArg (SA.Name conName2) + pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2) + pure $ + things + & map + ( \(typeName, prettyCon1, prettyCon2) -> + -- Note [ConstructorAliasMessage] If you change this, also change the other similar one + P.wrap ("The type" <> prettyName typeName <> "has a constructor with multiple names.") + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines [prettyCon1, prettyCon2]) + <> P.newline + <> P.newline + <> P.wrap "Please delete all but one name for each constructor." + ) + & P.sep "\n\n" + + prettyMissingConstructorNames <- + case NEList.nonEmpty todo.incoherentDeclReasons.missingConstructorNames of + Nothing -> pure mempty + Just types0 -> do + stuff <- + for types0 \typ -> do + n <- addNumberedArg (SA.Name typ) + pure (n, typ) + -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one + pure $ + P.wrap + "These types have some constructors with missing names." + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines (fmap (\(n, typ) -> formatNum n <> prettyName typ) stuff)) + <> P.newline + <> P.newline + <> P.wrap + ( "You can use" + <> IP.makeExample + IP.view + [ let firstNum = fst (NEList.head stuff) + lastNum = fst (NEList.last stuff) + in if firstNum == lastNum + then P.string (show firstNum) + else P.string (show firstNum) <> "-" <> P.string (show lastNum) + ] + <> "and" + <> IP.makeExample IP.aliasTerm ["", "."] + <> "to give names to each unnamed constructor." + ) + + prettyNestedDeclAliases <- + case todo.incoherentDeclReasons.nestedDeclAliases of + [] -> pure mempty + aliases0 -> do + aliases1 <- + for aliases0 \(short, long) -> do + n1 <- addNumberedArg (SA.Name short) + n2 <- addNumberedArg (SA.Name long) + pure (formatNum n1 <> prettyName short, formatNum n2 <> prettyName long) + -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one + pure $ + aliases1 + & map + ( \(short, long) -> + P.wrap + ( "These types are aliases, but one is nested under the other. Please separate them or delete" + <> "one copy." + ) + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines [short, long]) + ) + & P.sep "\n\n" + + prettyStrayConstructors <- + case todo.incoherentDeclReasons.strayConstructors of + [] -> pure mempty + constructors -> do + nums <- + for constructors \constructor -> do + addNumberedArg (SA.Name constructor) + -- Note [StrayConstructorMessage] If you change this, also change the other similar one + pure $ + P.wrap "These constructors are not nested beneath their corresponding type names:" + <> P.newline + <> P.newline + <> P.indentN + 2 + ( P.lines + ( zipWith + (\n constructor -> formatNum n <> prettyName constructor) + nums + constructors + ) + ) + <> P.newline + <> P.newline + <> P.wrap + ( "For each one, please either use" + <> IP.makeExample' IP.moveAll + <> "to move if, or if it's an extra copy, you can simply" + <> IP.makeExample' IP.delete + <> "it." + ) + + (pure . P.sep "\n\n" . P.nonEmpty) + [ prettyDependentsOfTodo, + prettyDirectTermDependenciesWithoutNames, + prettyDirectTypeDependenciesWithoutNames, + prettyConflicts, + prettyDefnsInLib, + prettyConstructorAliases, + prettyMissingConstructorNames, + prettyNestedDeclAliases, + prettyStrayConstructors + ] listOfDefinitions :: (Var v) => Input.FindScope -> PPE.PrettyPrintEnv -> E.ListDetailed -> [SR'.SearchResult' v a] -> IO Pretty @@ -3535,7 +3537,7 @@ listDependentsOrDependencies ppe labelStart label lds types terms = P.lines $ [ P.indentN 2 $ P.bold "Types:", "", - P.indentN 2 $ P.numbered (numFrom 0) $ c . prettyHashQualified <$> types + P.indentN 2 . P.numberedList $ c . prettyHashQualified <$> types ] termsOut = if null terms @@ -3544,7 +3546,47 @@ listDependentsOrDependencies ppe labelStart label lds types terms = P.lines [ P.indentN 2 $ P.bold "Terms:", "", - P.indentN 2 $ P.numbered (numFrom $ length types) $ c . prettyHashQualified <$> terms + P.indentN 2 . P.numberedListFrom (length types) $ c . prettyHashQualified <$> terms ] - numFrom k n = P.hiBlack $ P.shown (k + n) <> "." c = P.syntaxToColor + +displayProjectBranchReflogEntries :: + Maybe UTCTime -> + E.MoreEntriesThanShown -> + [ProjectReflog.Entry Project ProjectBranch (CausalHash, ShortCausalHash)] -> + (Pretty, NumberedArgs) +displayProjectBranchReflogEntries _ _ [] = + (P.warnCallout "The reflog is empty", mempty) +displayProjectBranchReflogEntries mayNow _ entries = + let (entryRows, numberedArgs) = foldMap renderEntry entries + rendered = + P.lines + [ header, + "", + P.numberedColumnNHeader (["Branch"] <> Monoid.whenM (isJust mayNow) ["When"] <> ["Hash", "Description"]) entryRows + ] + in (rendered, numberedArgs) + where + header = + P.lines + [ P.wrap $ + "Below is a record of recent changes, you can use " + <> IP.makeExample IP.reset ["#abcdef"] + <> " to reset the current branch to a previous state.", + "", + tip $ "Use " <> IP.makeExample IP.diffNamespace ["1", "7"] <> " to compare between points in history." + ] + renderEntry :: ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash) -> ([[Pretty]], NumberedArgs) + renderEntry ProjectReflog.Entry {time, project, branch, toRootCausalHash = (toCH, toSCH), reason} = + ( [ [prettyProjectAndBranchName $ ProjectAndBranch project.name branch.name] + <> ( mayNow + & foldMap (\now -> [prettyHumanReadableTime now time]) + ) + <> [P.blue (prettySCH toSCH), P.text $ truncateReason reason] + ], + [SA.Namespace toCH] + ) + truncateReason :: Text -> Text + truncateReason txt = case Text.splitAt 60 txt of + (short, "") -> short + (short, _) -> short <> "..." diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 867a08ed1e..7ec47063b1 100644 --- a/unison-cli/src/Unison/LSP.hs +++ b/unison-cli/src/Unison/LSP.hs @@ -27,9 +27,8 @@ import Language.LSP.VFS import Network.Simple.TCP qualified as TCP import System.Environment (lookupEnv) import System.IO (hPutStrLn) -import U.Codebase.HashTags import Unison.Codebase -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug import Unison.LSP.CancelRequest (cancelRequestHandler) @@ -47,6 +46,7 @@ import Unison.LSP.NotificationHandlers qualified as Notifications import Unison.LSP.Orphans () import Unison.LSP.Types import Unison.LSP.UCMWorker (ucmWorker) +import Unison.LSP.Util.Signal (Signal) import Unison.LSP.VFS qualified as VFS import Unison.Parser.Ann import Unison.Prelude @@ -61,8 +61,13 @@ getLspPort :: IO String getLspPort = fromMaybe "5757" <$> lookupEnv "UNISON_LSP_PORT" -- | Spawn an LSP server on the configured port. -spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> IO () -spawnLsp lspFormattingConfig codebase runtime latestRootHash latestPath = +spawnLsp :: + LspFormattingConfig -> + Codebase IO Symbol Ann -> + Runtime Symbol -> + Signal PP.ProjectPathIds -> + IO () +spawnLsp lspFormattingConfig codebase runtime signal = ifEnabled . TCP.withSocketsDo $ do lspPort <- getLspPort UnliftIO.handleIO (handleFailure lspPort) $ do @@ -80,9 +85,9 @@ spawnLsp lspFormattingConfig codebase runtime latestRootHash latestPath = -- currently we have an independent VFS for each LSP client since each client might have -- different un-saved state for the same file. - initVFS $ \vfs -> do - vfsVar <- newMVar vfs - void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath) + do + vfsVar <- newMVar emptyVFS + void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope signal) where handleFailure :: String -> IOException -> IO () handleFailure lspPort ioerr = @@ -113,16 +118,15 @@ serverDefinition :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> - STM CausalHash -> - STM (Path.Absolute) -> + Signal PP.ProjectPathIds -> ServerDefinition Config -serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath = +serverDefinition lspFormattingConfig vfsVar codebase runtime scope signal = ServerDefinition { defaultConfig = defaultLSPConfig, configSection = "unison", parseConfig = Config.parseConfig, onConfigChange = Config.updateConfig, - doInitialize = lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath, + doInitialize = lspDoInitialize vfsVar codebase runtime scope signal, staticHandlers = lspStaticHandlers lspFormattingConfig, interpretHandler = lspInterpretHandler, options = lspOptions @@ -134,12 +138,11 @@ lspDoInitialize :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> - STM CausalHash -> - STM (Path.Absolute) -> + Signal PP.ProjectPathIds -> LanguageContextEnv Config -> Msg.TMessage 'Msg.Method_Initialize -> IO (Either Msg.ResponseError Env) -lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspContext _initMsg = do +lspDoInitialize vfsVar codebase runtime scope signal lspContext _initMsg = do checkedFilesVar <- newTVarIO mempty dirtyFilesVar <- newTVarIO mempty ppedCacheVar <- newEmptyTMVarIO @@ -152,13 +155,13 @@ lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspConte Env { ppedCache = atomically $ readTMVar ppedCacheVar, currentNamesCache = atomically $ readTMVar currentNamesCacheVar, - currentPathCache = atomically $ readTMVar currentPathCacheVar, + currentProjectPathCache = atomically $ readTMVar currentPathCacheVar, nameSearchCache = atomically $ readTMVar nameSearchCacheVar, .. } let lspToIO = flip runReaderT lspContext . unLspT . flip runReaderT env . runLspM Ki.fork scope (lspToIO Analysis.fileAnalysisWorker) - Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestRootHash latestPath) + Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar signal) pure $ Right $ env -- | LSP request handlers that don't register/unregister dynamically diff --git a/unison-cli/src/Unison/LSP/CodeLens.hs b/unison-cli/src/Unison/LSP/CodeLens.hs index 38df42a72e..a5017ee99d 100644 --- a/unison-cli/src/Unison/LSP/CodeLens.hs +++ b/unison-cli/src/Unison/LSP/CodeLens.hs @@ -6,7 +6,6 @@ module Unison.LSP.CodeLens where import Control.Lens hiding (List) -import Control.Monad.Except import Data.Aeson qualified as Aeson import Data.Map qualified as Map import Data.Text qualified as Text diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index 129ba8bc54..d822c62be2 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -3,7 +3,14 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} -module Unison.LSP.Completion where +module Unison.LSP.Completion + ( completionHandler, + completionItemResolveHandler, + namesToCompletionTree, + -- Exported for transcript tests + completionsForQuery, + ) +where import Control.Comonad.Cofree import Control.Lens hiding (List, (:<)) @@ -11,6 +18,7 @@ import Control.Monad.Reader import Data.Aeson qualified as Aeson import Data.Aeson.Types qualified as Aeson import Data.Foldable qualified as Foldable +import Data.List qualified as List import Data.List.Extra (nubOrdOn) import Data.List.NonEmpty (NonEmpty (..)) import Data.Map qualified as Map @@ -23,7 +31,7 @@ import Text.Megaparsec qualified as Megaparsec import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LSP.FileAnalysis import Unison.LSP.Queries qualified as LSPQ import Unison.LSP.Types @@ -43,7 +51,7 @@ import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Runtime.IOSource qualified as IOSource import Unison.Syntax.DeclPrinter qualified as DeclPrinter -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Name qualified as Name (nameP, parseText, toText) import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Util.Monoid qualified as Monoid @@ -58,26 +66,30 @@ completionHandler m respond = (range, prefix) <- VFS.completionPrefix (m ^. params . textDocument . uri) (m ^. params . position) ppe <- PPED.suffixifiedPPE <$> lift currentPPED codebaseCompletions <- lift getCodebaseCompletions - -- Config {maxCompletions} <- lift getConfig - let defMatches = matchCompletions codebaseCompletions prefix - let (isIncomplete, defCompletions) = - defMatches - & nubOrdOn (\(p, _name, ref) -> (p, ref)) - & fmap (over _1 Path.toText) - & (False,) - -- case maxCompletions of - -- Nothing -> (False,) - -- Just n -> takeCompletions n + let (isIncomplete, matches) = completionsForQuery codebaseCompletions prefix let defCompletionItems = - defCompletions + matches & mapMaybe \(path, fqn, dep) -> let biasedPPE = PPE.biasTo [fqn] ppe hqName = LD.fold (PPE.types biasedPPE) (PPE.terms biasedPPE) dep in hqName <&> \hqName -> mkDefCompletionItem fileUri range (HQ'.toName hqName) fqn path (HQ'.toText hqName) dep + let itemDefaults = Nothing pure . CompletionList isIncomplete itemDefaults $ defCompletionItems where +completionsForQuery :: CompletionTree -> Text -> (Bool, [(Text, Name, LabeledDependency)]) +completionsForQuery codebaseCompletions prefix = + let defMatches = matchCompletions codebaseCompletions prefix + (isIncomplete, defCompletions) = + defMatches + -- sort shorter names first + & sortOn (matchSortCriteria . view _2) + & nubOrdOn (\(p, _name, ref) -> (p, ref)) + & fmap (over _1 Path.toText) + & (False,) + in (isIncomplete, defCompletions) + -- Takes at most the specified number of completions, but also indicates with a boolean -- whether there were more completions remaining so we can pass that along to the client. -- takeCompletions :: Int -> [a] -> (Bool, [a]) @@ -100,7 +112,9 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi _documentation = Nothing, _deprecated = Nothing, _preselect = Nothing, - _sortText = Nothing, + _sortText = + let (nls, ns, fn) = matchSortCriteria fullyQualifiedName + in Just $ Text.intercalate "|" [paddedInt nls, paddedInt ns, Name.toText fn], _filterText = Just path, _insertText = Nothing, _insertTextFormat = Nothing, @@ -113,6 +127,13 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi _data_ = Just $ Aeson.toJSON $ CompletionItemDetails {dep, relativeName, fullyQualifiedName, fileUri} } where + -- Pads an integer with zeroes so it sorts lexicographically in the right order + -- + -- >>> paddedInt 1 + -- "00001" + paddedInt :: Int -> Text + paddedInt n = + Text.justifyRight 5 '0' (Text.pack $ show n) -- We should generally show the longer of the path or suffixified name in the label, -- it helps the user understand the difference between options which may otherwise look -- the same. @@ -131,6 +152,21 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi then path else suffixified +-- | LSP clients sort completions using a text field, so we have to convert Unison's sort criteria to text. +matchSortCriteria :: Name -> (Int, Int, Name) +matchSortCriteria fqn = + (numLibSegments, numSegments, fqn) + where + numSegments :: Int + numSegments = + Name.countSegments fqn + numLibSegments :: Int + numLibSegments = + Name.reverseSegments fqn + & Foldable.toList + & List.filter (== NameSegment.libSegment) + & List.length + -- | Generate a completion tree from a set of names. -- A completion tree is a suffix tree over the path segments of each name it contains. -- The goal is to allow fast completion of names by any partial path suffix. diff --git a/unison-cli/src/Unison/LSP/Configuration.hs b/unison-cli/src/Unison/LSP/Configuration.hs index e47bff3d76..a95badc33a 100644 --- a/unison-cli/src/Unison/LSP/Configuration.hs +++ b/unison-cli/src/Unison/LSP/Configuration.hs @@ -9,7 +9,7 @@ import Unison.LSP.Types import Unison.Prelude -- | Handle configuration changes. -updateConfig :: Applicative m => Config -> m () +updateConfig :: (Applicative m) => Config -> m () updateConfig _newConfig = pure () parseConfig :: Config -> Value -> Either Text Config diff --git a/unison-cli/src/Unison/LSP/Conversions.hs b/unison-cli/src/Unison/LSP/Conversions.hs index 307fd5c99d..f6163485cb 100644 --- a/unison-cli/src/Unison/LSP/Conversions.hs +++ b/unison-cli/src/Unison/LSP/Conversions.hs @@ -49,3 +49,10 @@ annToRange = \case Ann.External -> Nothing Ann.GeneratedFrom a -> annToRange a Ann.Ann start end -> Just $ Range (uToLspPos start) (uToLspPos end) + +annToURange :: Ann.Ann -> Maybe Range.Range +annToURange = \case + Ann.Intrinsic -> Nothing + Ann.External -> Nothing + Ann.GeneratedFrom a -> annToURange a + Ann.Ann start end -> Just $ Range.Range start end diff --git a/unison-cli/src/Unison/LSP/Diagnostics.hs b/unison-cli/src/Unison/LSP/Diagnostics.hs index bf9d154980..9416fec9bb 100644 --- a/unison-cli/src/Unison/LSP/Diagnostics.hs +++ b/unison-cli/src/Unison/LSP/Diagnostics.hs @@ -9,6 +9,7 @@ import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types import Unison.LSP.Types import Unison.Prelude +import Unison.Util.Monoid qualified as Monoid reportDiagnostics :: (Foldable f) => @@ -23,15 +24,15 @@ reportDiagnostics docUri fileVersion diags = do let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = toList $ diags} sendNotification (Msg.TNotificationMessage jsonRPC Msg.SMethod_TextDocumentPublishDiagnostics params) -mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> Text -> [(Text, Range)] -> Diagnostic -mkDiagnostic uri r severity msg references = +mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> [DiagnosticTag] -> Text -> [(Text, Range)] -> Diagnostic +mkDiagnostic uri r severity tags msg references = Diagnostic { _range = r, _severity = Just severity, _code = Nothing, -- We could eventually pass error codes here _source = Just "unison", _message = msg, - _tags = Nothing, + _tags = Monoid.whenM (not $ null tags) (Just tags), _relatedInformation = case references of [] -> Nothing diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index f5f29b5e27..7a7ae006cf 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -35,6 +35,7 @@ import Unison.KindInference.Error qualified as KindInference import Unison.LSP.Conversions import Unison.LSP.Conversions qualified as Cv import Unison.LSP.Diagnostics (DiagnosticSeverity (..), mkDiagnostic, reportDiagnostics) +import Unison.LSP.FileAnalysis.UnusedBindings qualified as UnusedBindings import Unison.LSP.Orphans () import Unison.LSP.Types import Unison.LSP.VFS qualified as VFS @@ -55,7 +56,7 @@ import Unison.Referent qualified as Referent import Unison.Result (Note) import Unison.Result qualified as Result import Unison.Symbol (Symbol) -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name import Unison.Syntax.Parser qualified as Parser @@ -77,7 +78,7 @@ import Witherable -- | Lex, parse, and typecheck a file. checkFile :: (HasUri d Uri) => d -> Lsp (Maybe FileAnalysis) checkFile doc = runMaybeT do - currentPath <- lift getCurrentPath + pp <- lift getCurrentProjectPath let fileUri = doc ^. uri (fileVersion, contents) <- VFS.getFileContents fileUri parseNames <- lift getCurrentNames @@ -90,7 +91,7 @@ checkFile doc = runMaybeT do let parsingEnv = Parser.ParsingEnv { uniqueNames = uniqueName, - uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath, + uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, names = parseNames } (notes, parsedFile, typecheckedFile) <- do @@ -111,12 +112,13 @@ checkFile doc = runMaybeT do & toRangeMap let typeSignatureHints = fromMaybe mempty (mkTypeSignatureHints <$> parsedFile <*> typecheckedFile) let fileSummary = FileSummary.mkFileSummary parsedFile typecheckedFile + let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . folding (\(_topLevelAnn, _refId, trm, _type) -> UnusedBindings.analyseTerm fileUri trm) let tokenMap = getTokenMap tokens conflictWarningDiagnostics <- fold <$> for fileSummary \fs -> lift $ computeConflictWarningDiagnostics fileUri fs let diagnosticRanges = - (errDiagnostics <> conflictWarningDiagnostics) + (errDiagnostics <> conflictWarningDiagnostics <> unusedBindingDiagnostics) & fmap (\d -> (d ^. range, d)) & toRangeMap let fileAnalysis = FileAnalysis {diagnostics = diagnosticRanges, codeActions = codeActionRanges, fileSummary, typeSignatureHints, ..} @@ -192,6 +194,7 @@ computeConflictWarningDiagnostics fileUri fileSummary@FileSummary {fileNames} = fileUri newRange DiagnosticSeverity_Information + [] msg mempty pure $ toDiagnostics conflictedTermLocations <> toDiagnostics conflictedTypeLocations @@ -278,7 +281,7 @@ analyseNotes fileUri ppe src notes = do (errMsg, ranges) <- PrintError.renderParseErrors src err let txtMsg = Text.pack $ Pretty.toPlain 80 errMsg range <- ranges - pure $ mkDiagnostic fileUri (uToLspRange range) DiagnosticSeverity_Error txtMsg [] + pure $ mkDiagnostic fileUri (uToLspRange range) DiagnosticSeverity_Error [] txtMsg [] -- TODO: Some parsing errors likely have reasonable code actions pure (diags, []) Result.UnknownSymbol _ loc -> @@ -334,7 +337,7 @@ analyseNotes fileUri ppe src notes = do let msg = Text.pack $ Pretty.toPlain 80 $ PrintError.printNoteWithSource ppe src note in do (range, references) <- ranges - pure $ mkDiagnostic fileUri range DiagnosticSeverity_Error msg references + pure $ mkDiagnostic fileUri range DiagnosticSeverity_Error [] msg references -- Suggest name replacements or qualifications when there's ambiguity nameResolutionCodeActions :: [Diagnostic] -> [Context.Suggestion Symbol Ann] -> [RangedCodeAction] nameResolutionCodeActions diags suggestions = do diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs new file mode 100644 index 0000000000..46d87c6ec1 --- /dev/null +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -0,0 +1,52 @@ +module Unison.LSP.FileAnalysis.UnusedBindings where + +import Data.Foldable qualified as Foldable +import Data.Map qualified as Map +import Data.Set qualified as Set +import Data.Text qualified as Text +import Language.LSP.Protocol.Types (Diagnostic) +import Language.LSP.Protocol.Types qualified as Lsp +import U.Core.ABT (ABT (..)) +import U.Core.ABT qualified as ABT +import Unison.LSP.Conversions qualified as Cv +import Unison.LSP.Diagnostics qualified as Diagnostic +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Symbol (Symbol (..)) +import Unison.Term (Term) +import Unison.Util.Range qualified as Range +import Unison.Var qualified as Var + +analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] +analyseTerm fileUri tm = + let (unusedVars, _) = ABT.cata alg tm + vars = + Map.toList unusedVars & mapMaybe \(v, ann) -> do + (,ann) <$> getRelevantVarName v + diagnostics = + vars & mapMaybe \(varName, ann) -> do + -- Limit the range to the first line of the binding to not be too annoying. + -- Maybe in the future we can get the actual annotation of the variable name. + lspRange <- Cv.uToLspRange . Range.startingLine <$> Cv.annToURange ann + pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning [Lsp.DiagnosticTag_Unnecessary] ("Unused binding " <> tShow varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") [] + in diagnostics + where + getRelevantVarName :: Symbol -> Maybe Text + getRelevantVarName = \case + -- Sometimes 'do' gets a binding of '()', which we don't care about + Symbol _ (Var.User "()") -> Nothing + Symbol _ (Var.User "") -> Nothing + -- We only care about user bindings which don't start with an underscore + Symbol _ (Var.User n) -> do + guard (not (Text.isPrefixOf "_" n)) + Just n + _ -> Nothing + alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v) + alg ann abt = case abt of + Var v -> (mempty, Set.singleton v) + Cycle x -> x + Abs v (unusedBindings, usedVars) -> + if v `Set.member` usedVars + then (unusedBindings, Set.delete v usedVars) + else (Map.insert v ann unusedBindings, usedVars) + Tm fx -> Foldable.fold fx diff --git a/unison-cli/src/Unison/LSP/Formatting.hs b/unison-cli/src/Unison/LSP/Formatting.hs index 48e46d8028..ebba4b1a81 100644 --- a/unison-cli/src/Unison/LSP/Formatting.hs +++ b/unison-cli/src/Unison/LSP/Formatting.hs @@ -8,6 +8,7 @@ import Language.LSP.Protocol.Lens import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Formatting +import Unison.Codebase.ProjectPath qualified as PP import Unison.LSP.Conversions (lspToURange, uToLspRange) import Unison.LSP.FileAnalysis (getFileAnalysis) import Unison.LSP.FileAnalysis qualified as FileAnalysis @@ -30,10 +31,10 @@ formatDefs :: Uri -> Maybe (Set Range {- the ranges to format, if Nothing then f formatDefs fileUri mayRangesToFormat = fromMaybe [] <$> runMaybeT do FileAnalysis {parsedFile = mayParsedFile, typecheckedFile = mayTypecheckedFile} <- getFileAnalysis fileUri - currentPath <- lift getCurrentPath + pp <- lift getCurrentProjectPath Config {formattingWidth} <- lift getConfig MaybeT $ - Formatting.formatFile (\uf tf -> FileAnalysis.ppedForFileHelper uf tf) formattingWidth currentPath mayParsedFile mayTypecheckedFile (Set.map lspToURange <$> mayRangesToFormat) + Formatting.formatFile (\uf tf -> FileAnalysis.ppedForFileHelper uf tf) formattingWidth (pp ^. PP.absPath_) mayParsedFile mayTypecheckedFile (Set.map lspToURange <$> mayRangesToFormat) <&> (fmap . fmap) uTextReplacementToLSP where uTextReplacementToLSP :: Formatting.TextReplacement -> TextEdit diff --git a/unison-cli/src/Unison/LSP/Queries.hs b/unison-cli/src/Unison/LSP/Queries.hs index b6e87497cf..9613781937 100644 --- a/unison-cli/src/Unison/LSP/Queries.hs +++ b/unison-cli/src/Unison/LSP/Queries.hs @@ -198,14 +198,14 @@ instance Functor SourceNode where -- children contain that position. findSmallestEnclosingNode :: Pos -> Term Symbol Ann -> Maybe (SourceNode Ann) findSmallestEnclosingNode pos term - | annIsFilePosition (ABT.annotation term) && not (ABT.annotation term `Ann.contains` pos) = Nothing + | annIsFilePosition ann && not (ann `Ann.contains` pos) = Nothing | Just r <- cleanImplicitUnit term = findSmallestEnclosingNode pos r | otherwise = do -- For leaf nodes we require that they be an in-file position, not Intrinsic or -- external. -- In some rare cases it's possible for an External/Intrinsic node to have children that -- ARE in the file, so we need to make sure we still crawl their children. - let guardInFile = guard (annIsFilePosition (ABT.annotation term)) + let guardInFile = guard (annIsFilePosition ann) let bestChild = case ABT.out term of ABT.Tm f -> case f of Term.Int {} -> guardInFile *> Just (TermNode term) @@ -244,7 +244,7 @@ findSmallestEnclosingNode pos term ABT.Var _v -> guardInFile *> Just (TermNode term) ABT.Cycle r -> findSmallestEnclosingNode pos r ABT.Abs _v r -> findSmallestEnclosingNode pos r - let fallback = if annIsFilePosition (ABT.annotation term) then Just (TermNode term) else Nothing + let fallback = if annIsFilePosition ann then Just (TermNode term) else Nothing bestChild <|> fallback where -- tuples always end in an implicit unit, but it's annotated with the span of the whole @@ -256,6 +256,13 @@ findSmallestEnclosingNode pos term ABT.Tm' (Term.App (ABT.Tm' (Term.App (ABT.Tm' (Term.Constructor (ConstructorReference ref 0))) x)) trm) | ref == Builtins.pairRef && Term.amap (const ()) trm == Builtins.unitTerm () -> Just x _ -> Nothing + ann = getTermSpanAnn term + +-- | Most nodes have the property that their annotation spans all their children, but there are some exceptions. +getTermSpanAnn :: Term Symbol Ann -> Ann +getTermSpanAnn tm = case ABT.out tm of + ABT.Abs _v r -> ABT.annotation tm <> getTermSpanAnn r + _ -> ABT.annotation tm findSmallestEnclosingPattern :: Pos -> Pattern.Pattern Ann -> Maybe (Pattern.Pattern Ann) findSmallestEnclosingPattern pos pat diff --git a/unison-cli/src/Unison/LSP/Types.hs b/unison-cli/src/Unison/LSP/Types.hs index c5fe0e9a95..b368e915ef 100644 --- a/unison-cli/src/Unison/LSP/Types.hs +++ b/unison-cli/src/Unison/LSP/Types.hs @@ -24,7 +24,7 @@ import Language.LSP.Server import Language.LSP.Server qualified as LSP import Language.LSP.VFS import Unison.Codebase -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug import Unison.LSP.Orphans () @@ -72,7 +72,7 @@ data Env = Env currentNamesCache :: IO Names, ppedCache :: IO PrettyPrintEnvDecl, nameSearchCache :: IO (NameSearch Sqlite.Transaction), - currentPathCache :: IO Path.Absolute, + currentProjectPathCache :: IO PP.ProjectPath, vfsVar :: MVar VFS, runtime :: Runtime Symbol, -- The information we have for each file. @@ -129,8 +129,8 @@ data FileAnalysis = FileAnalysis } deriving stock (Show) -getCurrentPath :: Lsp Path.Absolute -getCurrentPath = asks currentPathCache >>= liftIO +getCurrentProjectPath :: Lsp PP.ProjectPath +getCurrentProjectPath = asks currentProjectPathCache >>= liftIO getCodebaseCompletions :: Lsp CompletionTree getCodebaseCompletions = asks completionsVar >>= atomically . readTMVar diff --git a/unison-cli/src/Unison/LSP/UCMWorker.hs b/unison-cli/src/Unison/LSP/UCMWorker.hs index 2f28955021..713ce207f6 100644 --- a/unison-cli/src/Unison/LSP/UCMWorker.hs +++ b/unison-cli/src/Unison/LSP/UCMWorker.hs @@ -1,16 +1,18 @@ module Unison.LSP.UCMWorker where import Control.Monad.Reader -import U.Codebase.HashTags import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch -import Unison.Codebase.Path qualified as Path -import Unison.Debug qualified as Debug +import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.ProjectPath qualified as PP import Unison.LSP.Completion import Unison.LSP.Types +import Unison.LSP.Util.Signal (Signal) +import Unison.LSP.Util.Signal qualified as Signal import Unison.LSP.VFS qualified as VFS import Unison.Names (Names) +import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl import Unison.PrettyPrintEnvDecl.Names qualified as PPED @@ -24,42 +26,43 @@ ucmWorker :: TMVar PrettyPrintEnvDecl -> TMVar Names -> TMVar (NameSearch Sqlite.Transaction) -> - TMVar Path.Absolute -> - STM CausalHash -> - STM Path.Absolute -> + TMVar ProjectPath -> + Signal PP.ProjectPathIds -> Lsp () -ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestRoot getLatestPath = do - Env {codebase, completionsVar} <- ask - let loop :: (CausalHash, Path.Absolute) -> Lsp a - loop (currentRoot, currentPath) = do - Debug.debugM Debug.LSP "LSP path: " currentPath - currentBranch0 <- fmap Branch.head . liftIO $ (Codebase.getBranchAtPath codebase currentPath) - let currentNames = Branch.toNames currentBranch0 - hl <- liftIO $ Codebase.runTransaction codebase Codebase.hashLength - let pped = PPED.makePPED (PPE.hqNamer hl currentNames) (PPE.suffixifyByHash currentNames) - atomically $ do - writeTMVar currentPathVar currentPath - writeTMVar currentNamesVar currentNames - writeTMVar ppedVar pped - writeTMVar nameSearchCacheVar (NameSearch.makeNameSearch hl currentNames) - -- Re-check everything with the new names and ppe - VFS.markAllFilesDirty - atomically do - writeTMVar completionsVar (namesToCompletionTree currentNames) - Debug.debugLogM Debug.LSP "LSP Initialized" - latest <- atomically $ do - latestRoot <- getLatestRoot - latestPath <- getLatestPath - guard $ (currentRoot /= latestRoot || currentPath /= latestPath) - pure (latestRoot, latestPath) - Debug.debugLogM Debug.LSP "LSP Change detected" - loop latest - (rootBranch, currentPath) <- atomically $ do - rootBranch <- getLatestRoot - currentPath <- getLatestPath - pure (rootBranch, currentPath) - loop (rootBranch, currentPath) +ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar changeSignal = do + signalChanges <- Signal.subscribe changeSignal + loop signalChanges Nothing where + loop :: STM PP.ProjectPathIds -> Maybe (Branch.Branch IO) -> Lsp a + loop signalChanges currentBranch = do + Env {codebase, completionsVar} <- ask + getChanges signalChanges currentBranch >>= \case + (_newPP, Nothing) -> loop signalChanges currentBranch + (newPP, Just newBranch) -> do + let newBranch0 = Branch.head newBranch + let newNames = Branch.toNames newBranch0 + hl <- liftIO $ Codebase.runTransaction codebase Codebase.hashLength + let pped = PPED.makePPED (PPE.hqNamer hl newNames) (PPE.suffixifyByHash newNames) + atomically $ do + writeTMVar currentPathVar newPP + writeTMVar currentNamesVar newNames + writeTMVar ppedVar pped + writeTMVar nameSearchCacheVar (NameSearch.makeNameSearch hl newNames) + -- Re-check everything with the new names and ppe + VFS.markAllFilesDirty + atomically do + writeTMVar completionsVar (namesToCompletionTree newNames) + loop signalChanges (Just newBranch) + -- Waits for a possible change, then checks if there's actually any difference to the branches we care about. + -- If so, returns the new branch, otherwise Nothing. + getChanges :: STM PP.ProjectPathIds -> Maybe (Branch.Branch IO) -> Lsp (ProjectPath, Maybe (Branch.Branch IO)) + getChanges signalChanges currentBranch = do + Env {codebase} <- ask + ppIds <- atomically signalChanges + pp <- liftIO . Codebase.runTransaction codebase $ Codebase.resolveProjectPathIds ppIds + atomically $ writeTMVar currentPathVar pp + newBranch <- fmap (fromMaybe Branch.empty) . liftIO $ Codebase.getBranchAtProjectPath codebase pp + pure $ (pp, if Just newBranch == currentBranch then Nothing else Just newBranch) -- This is added in stm-2.5.1, remove this if we upgrade. writeTMVar :: TMVar a -> a -> STM () writeTMVar var a = diff --git a/unison-cli/src/Unison/LSP/Util/Signal.hs b/unison-cli/src/Unison/LSP/Util/Signal.hs new file mode 100644 index 0000000000..e06dfca111 --- /dev/null +++ b/unison-cli/src/Unison/LSP/Util/Signal.hs @@ -0,0 +1,74 @@ +-- | A transactional signal type. +-- Similar to a broadcast channel, but with better memory characteristics when you only care about the latest value. +-- +-- Allows multiple consumers to detect the latest value of a signal, and to be notified when the signal changes. +module Unison.LSP.Util.Signal + ( newSignalIO, + writeSignal, + writeSignalIO, + subscribe, + Signal, + ) +where + +import Control.Monad.STM qualified as STM +import Unison.Prelude +import UnliftIO.STM + +newtype Signal a = Signal (TVar (Maybe a, Int)) + +-- | Create a new signal with an optional initial value. +newSignalIO :: (MonadIO m) => Maybe a -> m (Signal a) +newSignalIO a = do + tvar <- newTVarIO (a, 0) + pure (Signal tvar) + +-- | Update the value of a signal, notifying all subscribers (even if the value didn't change) +writeSignal :: Signal a -> a -> STM () +writeSignal (Signal signalVar) a = do + (_, n) <- readTVar signalVar + writeTVar signalVar (Just a, succ n) + +-- | Update the value of a signal, notifying all subscribers (even if the value didn't change) +writeSignalIO :: (MonadIO m) => Signal a -> a -> m () +writeSignalIO signal a = liftIO $ STM.atomically (writeSignal signal a) + +-- | Subscribe to a signal, returning an STM action which will read the latest NEW value, +-- after successfully reading a new value, subsequent reads will retry until there's a new value written to the signal. +-- +-- Each independent reader should have its own subscription. +-- +-- >>> signal <- newSignalIO (Just "initial") +-- >>> subscriber1 <- subscribe signal +-- >>> subscriber2 <- subscribe signal +-- >>> -- Should return the initial value +-- >>> atomically (optional subscriber1) +-- >>> -- Should retry, since the signal hasn't changed. +-- >>> atomically (optional subscriber1) +-- >>> writeSignalIO signal "new value" +-- >>> -- Each subscriber should return the newest value +-- >>> ("sub1",) <$> atomically (optional subscriber1) +-- >>> ("sub2",) <$> atomically (optional subscriber2) +-- >>> -- Both should now retry +-- >>> ("sub1",) <$> atomically (optional subscriber1) +-- >>> ("sub2",) <$> atomically (optional subscriber2) +-- Just "initial" +-- Nothing +-- ("sub1",Just "new value") +-- ("sub2",Just "new value") +-- ("sub1",Nothing) +-- ("sub2",Nothing) +subscribe :: (MonadIO m) => Signal a -> m (STM a) +subscribe (Signal signalVar) = do + (_, n) <- readTVarIO signalVar + -- Start with a different n, so the subscriber will trigger on its first read. + latestNVar <- newTVarIO (pred n) + pure $ do + (mayA, newN) <- readTVar signalVar + latestN <- readTVar latestNVar + guard (newN /= latestN) + writeTVar latestNVar newN + -- Retry until we have a value. + case mayA of + Nothing -> STM.retry + Just a -> pure a diff --git a/unison-cli/src/Unison/LSP/VFS.hs b/unison-cli/src/Unison/LSP/VFS.hs index 4be5573a45..8244d64615 100644 --- a/unison-cli/src/Unison/LSP/VFS.hs +++ b/unison-cli/src/Unison/LSP/VFS.hs @@ -81,7 +81,11 @@ identifierSplitAtPosition uri pos = do vf <- getVirtualFile uri PosPrefixInfo {fullLine, cursorPos} <- MaybeT (VFS.getCompletionPrefix pos vf) let (before, after) = Text.splitAt (cursorPos ^. character . to fromIntegral) fullLine - pure (Text.takeWhileEnd isIdentifierChar before, Text.takeWhile isIdentifierChar after) + pure + ( Text.takeWhileEnd isIdentifierChar before, + -- names can end with '!', and it's not a force, so we include it in the identifier if it's at the end. + Text.takeWhile (\c -> isIdentifierChar c || c == '!') after + ) where isIdentifierChar c = -- Manually exclude '!' and apostrophe, since those are usually just forces and diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 32e829c0b1..990f11354f 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -25,7 +25,6 @@ import ArgParse ) import Compat (defaultInterruptHandler, withInterruptHandler) import Control.Concurrent (newEmptyMVar, runInUnboundThread, takeMVar) -import Control.Concurrent.STM import Control.Exception (displayException, evaluate) import Data.ByteString.Lazy qualified as BL import Data.Configurator.Types (Config) @@ -48,6 +47,7 @@ import System.Directory ) import System.Environment (getExecutablePath, getProgName, withArgs) import System.Exit qualified as Exit +import System.Exit qualified as System import System.FilePath ( replaceExtension, takeDirectory, @@ -60,8 +60,9 @@ import System.IO.CodePage (withCP65001) import System.IO.Error (catchIOError) import System.IO.Temp qualified as Temp import System.Path qualified as Path -import U.Codebase.HashTags (CausalHash) +import Text.Megaparsec qualified as MP import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase, CodebasePath) import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Input qualified as Input @@ -70,16 +71,20 @@ import Unison.Codebase.Init (CodebaseInitOptions (..), InitError (..), InitResul import Unison.Codebase.Init qualified as CodebaseInit import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser qualified as TR +import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity -import Unison.CommandLine (plural', watchConfig) +import Unison.CommandLine (watchConfig) +import Unison.CommandLine.Helpers (plural') import Unison.CommandLine.Main qualified as CommandLine import Unison.CommandLine.Types qualified as CommandLine import Unison.CommandLine.Welcome (CodebaseInitStatus (..)) import Unison.CommandLine.Welcome qualified as Welcome +import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName (..), ProjectName (..)) import Unison.LSP qualified as LSP +import Unison.LSP.Util.Signal qualified as Signal import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyTerminal qualified as PT @@ -171,10 +176,9 @@ main version = 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 noOpRootNotifier _ = pure () - let noOpPathNotifier _ = pure () + let noOpCheckForChanges _ = pure () let serverUrl = Nothing - let startPath = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch version currentDir @@ -185,10 +189,9 @@ main version = do theCodebase [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] serverUrl - startPath + (PP.toIds startProjectPath) initRes - noOpRootNotifier - noOpPathNotifier + noOpCheckForChanges CommandLine.ShouldNotWatchFiles Run (RunFromPipe mainName) args -> do e <- safeReadUtf8StdIn @@ -198,10 +201,9 @@ main version = 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 noOpRootNotifier _ = pure () - let noOpPathNotifier _ = pure () + let noOpCheckForChanges _ = pure () let serverUrl = Nothing - let startPath = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch version currentDir @@ -212,10 +214,9 @@ main version = do theCodebase [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] serverUrl - startPath + (PP.toIds startProjectPath) initRes - noOpRootNotifier - noOpPathNotifier + noOpCheckForChanges CommandLine.ShouldNotWatchFiles Run (RunCompiled file) args -> BL.readFile file >>= \bs -> @@ -286,33 +287,38 @@ main version = do case mrtsStatsFp of Nothing -> action Just fp -> recordRtsStats fp action - Launch isHeadless codebaseServerOpts mayStartingPath shouldWatchFiles -> do + 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 - startingPath <- case isHeadless of - WithCLI -> 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 mayStartingPath of - Just startingPath -> pure startingPath - Nothing -> do - segments <- Codebase.runTransaction theCodebase Queries.expectMostRecentNamespace - pure (Path.Absolute (Path.fromList segments)) - Headless -> pure $ fromMaybe defaultInitialPath mayStartingPath - rootCausalHash <- Codebase.runTransaction theCodebase (Queries.expectNamespaceRoot >>= Queries.expectCausalHash) - rootCausalHashVar <- newTVarIO rootCausalHash - pathVar <- newTVarIO startingPath - let notifyOnRootChanges :: CausalHash -> STM () - notifyOnRootChanges b = do - writeTVar rootCausalHashVar b - let notifyOnPathChanges :: Path.Absolute -> STM () - notifyOnPathChanges = writeTVar pathVar + 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 (readTVar rootCausalHashVar) (readTVar pathVar) + 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 @@ -323,7 +329,7 @@ main version = do [ "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.LooseCodeUI Path.absoluteEmpty Nothing) baseUrl + 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 " @@ -346,10 +352,9 @@ main version = do theCodebase [] (Just baseUrl) - (Just startingPath) + (PP.toIds startingProjectPath) initRes - notifyOnRootChanges - notifyOnPathChanges + lspCheckForChanges shouldWatchFiles Exit -> do Exit.exitSuccess where @@ -420,48 +425,55 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles currentDir <- getCurrentDirectory configFilePath <- getConfigFilePath mcodepath -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously. - and <$> getCodebaseOrExit (Just (DontCreateCodebaseWhenMissing transcriptDir)) (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, codebasePath, theCodebase) -> do - TR.withTranscriptRunner Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp (Just configFilePath) $ \runTranscript -> do - for markdownFiles $ \(MarkdownFile fileName) -> do - transcriptSrc <- readUtf8 fileName - result <- runTranscript fileName transcriptSrc (codebasePath, theCodebase) - let outputFile = replaceExtension (currentDir fileName) ".output.md" - (output, succeeded) <- case result of - Left err -> case err of - TR.TranscriptParseError err -> do - PT.putPrettyLn $ - P.callout - "❓" - ( P.lines - [ P.indentN 2 "An error occurred while parsing the following file: " <> P.string fileName, - "", - P.indentN 2 $ P.text err - ] - ) - pure (err, False) - TR.TranscriptRunFailure err -> do - PT.putPrettyLn $ - P.callout - "❓" - ( P.lines - [ P.indentN 2 "An error occurred while running the following file: " <> P.string fileName, - "", - P.indentN 2 $ P.text err, - P.text $ - "Run `" - <> Text.pack progName - <> " --codebase " - <> Text.pack codebasePath - <> "` " - <> "to do more work with it." - ] + and + <$> getCodebaseOrExit + (Just (DontCreateCodebaseWhenMissing transcriptDir)) + (SC.MigrateAutomatically SC.Backup SC.Vacuum) + \(_, codebasePath, theCodebase) -> do + let isTest = False + Transcript.withRunner + isTest + Verbosity.Verbose + (Version.gitDescribeWithDate version) + nativeRtp + (Just configFilePath) + \runTranscript -> do + for markdownFiles $ \(MarkdownFile fileName) -> do + transcriptSrc <- readUtf8 fileName + result <- runTranscript fileName transcriptSrc (codebasePath, theCodebase) + let outputFile = replaceExtension (currentDir fileName) ".output.md" + output <- + either + ( uncurry ($>) . first (PT.putPrettyLn . P.callout "❓" . P.lines) . \case + Transcript.ParseError err -> + let msg = MP.errorBundlePretty err + in ( [ P.indentN 2 $ + "An error occurred while parsing the following file: " <> P.string fileName, + "", + P.indentN 2 $ P.string msg + ], + Text.pack msg + ) + Transcript.RunFailure msg -> + ( [ P.indentN 2 $ "An error occurred while running the following file: " <> P.string fileName, + "", + P.indentN 2 (P.text msg), + P.string $ + "Run `" + <> progName + <> " --codebase " + <> codebasePath + <> "` " + <> "to do more work with it." + ], + msg + ) ) - pure (err, False) - Right mdOut -> do - pure (mdOut, True) - writeUtf8 outputFile output - putStrLn $ "💾 Wrote " <> outputFile - pure succeeded + pure + result + writeUtf8 outputFile output + putStrLn $ "💾 Wrote " <> outputFile + pure $ isRight result runTranscripts :: Version -> @@ -512,9 +524,6 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba ) when (not completed) $ Exit.exitWith (Exit.ExitFailure 1) -defaultInitialPath :: Path.Absolute -defaultInitialPath = Path.absoluteEmpty - launch :: Version -> FilePath -> @@ -525,13 +534,12 @@ launch :: Codebase.Codebase IO Symbol Ann -> [Either Input.Event Input.Input] -> Maybe Server.BaseUrl -> - Maybe Path.Absolute -> + PP.ProjectPathIds -> InitResult -> - (CausalHash -> STM ()) -> - (Path.Absolute -> STM ()) -> + (PP.ProjectPathIds -> IO ()) -> CommandLine.ShouldWatchFiles -> IO () -launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl mayStartingPath initResult notifyRootChange notifyPathChange shouldWatchFiles = do +launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase @@ -541,7 +549,7 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU in CommandLine.main dir welcome - (fromMaybe defaultInitialPath mayStartingPath) + startingPath config inputs runtime @@ -550,8 +558,7 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU codebase serverBaseUrl ucmVersion - notifyRootChange - notifyPathChange + lspCheckForChanges shouldWatchFiles newtype MarkdownFile = MarkdownFile FilePath @@ -571,7 +578,8 @@ getConfigFilePath mcodepath = ( ".unisonConfig") <$> Codebase.getCodebaseDir getCodebaseOrExit :: Maybe CodebasePathOption -> SC.MigrationStrategy -> ((InitResult, CodebasePath, Codebase IO Symbol Ann) -> IO r) -> IO r getCodebaseOrExit codebasePathOption migrationStrategy action = do initOptions <- argsToCodebaseInitOptions codebasePathOption - result <- CodebaseInit.withOpenOrCreateCodebase SC.init "main" initOptions SC.DoLock migrationStrategy \case + let cbInit = SC.init + result <- CodebaseInit.withOpenOrCreateCodebase cbInit "main" initOptions SC.DoLock migrationStrategy \case cbInit@(CreatedCodebase, dir, _) -> do pDir <- prettyDir dir PT.putPrettyLn' "" diff --git a/unison-cli/src/Unison/Share/Sync.hs b/unison-cli/src/Unison/Share/Sync.hs index 8df14b8f99..aa08d01875 100644 --- a/unison-cli/src/Unison/Share/Sync.hs +++ b/unison-cli/src/Unison/Share/Sync.hs @@ -6,14 +6,10 @@ module Unison.Share.Sync getCausalHashByPath, GetCausalHashByPathError (..), - -- ** Push - checkAndSetPush, - CheckAndSetPushError (..), - fastForwardPush, - FastForwardPushError (..), + -- ** Upload uploadEntities, - -- ** Pull + -- ** Pull/Download pull, PullError (..), downloadEntities, @@ -26,16 +22,10 @@ import Control.Monad.Except import Control.Monad.Reader (ask) import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Control.Monad.Trans.Reader qualified as Reader -import Data.Foldable qualified as Foldable (find) -import Data.List.NonEmpty (pattern (:|)) -import Data.List.NonEmpty qualified as List (NonEmpty) -import Data.List.NonEmpty qualified as List.NonEmpty import Data.Map qualified as Map import Data.Map.NonEmpty (NEMap) import Data.Map.NonEmpty qualified as NEMap import Data.Proxy -import Data.Sequence.NonEmpty (NESeq ((:<||))) -import Data.Sequence.NonEmpty qualified as NESeq (fromList, nonEmptySeq, (><|)) import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet @@ -65,7 +55,7 @@ import Unison.Share.ExpectedHashMismatches (expectedCausalHashMismatches, expect import Unison.Share.Sync.Types import Unison.Sqlite qualified as Sqlite import Unison.Sync.API qualified as Share (API) -import Unison.Sync.Common (causalHashToHash32, entityToTempEntity, expectEntity, hash32ToCausalHash) +import Unison.Sync.Common (entityToTempEntity, expectEntity, hash32ToCausalHash) import Unison.Sync.EntityValidation qualified as EV import Unison.Sync.Types qualified as Share import Unison.Util.Monoid (foldMapM) @@ -98,300 +88,6 @@ syncChunkSize = unsafePerformIO $ do Nothing -> 50 {-# NOINLINE syncChunkSize #-} ------------------------------------------------------------------------------------------------------------------------- --- Push - --- | Perform a check-and-set push (initially of just a causal hash, but ultimately all of its dependencies that the --- server is missing, too) to Unison Share. --- --- This flavor of push takes the expected state of the server, and the desired state we want to set; if our expectation --- is off, we won't proceed with the push. -checkAndSetPush :: - -- | The Unison Share URL. - BaseUrl -> - -- | The repo+path to push to. - Share.Path -> - -- | The hash that we expect this repo+path to be at on Unison Share. If not, we'll get back a hash mismatch error. - -- This prevents accidentally pushing over data that we didn't know was there. - Maybe Hash32 -> - -- | The hash of our local causal to push. - CausalHash -> - -- | Callback that's given a number of entities we just uploaded. - (Int -> IO ()) -> - Cli (Either (SyncError CheckAndSetPushError) ()) -checkAndSetPush unisonShareUrl path expectedHash causalHash uploadedCallback = do - Cli.Env {authHTTPClient} <- ask - - Cli.label \done -> do - let failed :: SyncError CheckAndSetPushError -> Cli void - failed = done . Left - - let updatePathError :: Share.UpdatePathError -> Cli void - updatePathError err = - failed (SyncError (CheckAndSetPushError'UpdatePath (Share.pathRepoInfo path) err)) - - let updatePath :: Cli Share.UpdatePathResponse - updatePath = do - liftIO request & onLeftM \err -> failed (TransportError err) - where - request :: IO (Either CodeserverTransportError Share.UpdatePathResponse) - request = - httpUpdatePath - authHTTPClient - unisonShareUrl - Share.UpdatePathRequest - { path, - expectedHash, - newHash = causalHashToHash32 causalHash - } - - -- Maybe the server already has this causal; try just setting its remote path. Commonly, it will respond that it - -- needs this causal (UpdatePathMissingDependencies). - dependencies <- - updatePath >>= \case - Share.UpdatePathSuccess -> done (Right ()) - Share.UpdatePathFailure err -> - case err of - Share.UpdatePathError'MissingDependencies (Share.NeedDependencies dependencies) -> pure dependencies - _ -> updatePathError err - - -- Upload the causal and all of its dependencies. - uploadEntities unisonShareUrl (Share.pathRepoInfo path) dependencies uploadedCallback & onLeftM \err -> - failed (CheckAndSetPushError'UploadEntities <$> err) - - -- After uploading the causal and all of its dependencies, try setting the remote path again. - updatePath >>= \case - Share.UpdatePathSuccess -> pure (Right ()) - Share.UpdatePathFailure err -> updatePathError err - --- | Perform a fast-forward push (initially of just a causal hash, but ultimately all of its dependencies that the --- server is missing, too) to Unison Share. --- --- This flavor of push provides the server with a chain of causal hashes leading from its current state to our desired --- state. -fastForwardPush :: - -- | The Unison Share URL. - BaseUrl -> - -- | The repo+path to push to. - Share.Path -> - -- | The hash of our local causal to push. - CausalHash -> - -- | Callback that's given a number of entities we just uploaded. - (Int -> IO ()) -> - Cli (Either (SyncError FastForwardPushError) ()) -fastForwardPush unisonShareUrl path localHeadHash uploadedCallback = do - Cli.label \done -> do - let succeeded :: Cli void - succeeded = - done (Right ()) - - let failed :: SyncError FastForwardPushError -> Cli void - failed = done . Left - - let fastForwardPathError :: Share.FastForwardPathError -> Cli void - fastForwardPathError err = - failed (SyncError (FastForwardPushError'FastForwardPath path err)) - - remoteHeadHash <- - getCausalHashByPath unisonShareUrl path >>= \case - Left err -> failed (FastForwardPushError'GetCausalHash <$> err) - Right Nothing -> fastForwardPathError Share.FastForwardPathError'NoHistory - Right (Just remoteHeadHash) -> pure (Share.hashJWTHash remoteHeadHash) - - let doLoadCausalSpineBetween = do - -- (Temporary?) optimization - perform the "is ancestor?" check within sqlite before reconstructing the - -- actual path. - let isBefore :: Sqlite.Transaction Bool - isBefore = do - maybeHashIds <- - runMaybeT $ - (,) - <$> MaybeT (Q.loadCausalHashIdByCausalHash (hash32ToCausalHash remoteHeadHash)) - <*> MaybeT (Q.loadCausalHashIdByCausalHash localHeadHash) - case maybeHashIds of - Nothing -> pure False - Just (remoteHeadHashId, localHeadHashId) -> Q.before remoteHeadHashId localHeadHashId - isBefore >>= \case - False -> pure Nothing - True -> loadCausalSpineBetween remoteHeadHash (causalHashToHash32 localHeadHash) - - let doUpload :: List.NonEmpty CausalHash -> Cli () - -- Maybe we could save round trips here by including the tail (or the head *and* the tail) as "extra hashes", - -- but we don't have that API yet. So, we only upload the head causal entity (which we don't even know for sure - -- the server doesn't have yet), and will (eventually) end up uploading the casuals in the tail that the server - -- needs. - doUpload (headHash :| _tailHashes) = - request & onLeftM \err -> failed (FastForwardPushError'UploadEntities <$> err) - where - request = - uploadEntities - unisonShareUrl - (Share.pathRepoInfo path) - (NESet.singleton (causalHashToHash32 headHash)) - uploadedCallback - - localInnerHashes <- - Cli.runTransaction doLoadCausalSpineBetween >>= \case - -- After getting the remote causal hash, we can tell from a local computation that this wouldn't be a - -- fast-forward push, so we don't bother trying - just report the error now. - Nothing -> failed (SyncError (FastForwardPushError'NotFastForward path)) - -- The path from remote-to-local, excluding local, was empty. So, remote == local; there's nothing to push. - Just [] -> succeeded - -- drop remote hash - Just (_ : localInnerHashes) -> pure (map hash32ToCausalHash localInnerHashes) - - doUpload (localHeadHash :| localInnerHashes) - - let doFastForwardPath :: Cli Share.FastForwardPathResponse - doFastForwardPath = do - Cli.Env {authHTTPClient} <- ask - let request = - httpFastForwardPath - authHTTPClient - unisonShareUrl - Share.FastForwardPathRequest - { expectedHash = remoteHeadHash, - hashes = - causalHashToHash32 <$> List.NonEmpty.fromList (localInnerHashes ++ [localHeadHash]), - path - } - liftIO request & onLeftM \err -> failed (TransportError err) - - doFastForwardPath >>= \case - Share.FastForwardPathSuccess -> succeeded - Share.FastForwardPathFailure err -> fastForwardPathError err - --- Return a list (in oldest-to-newest order) of hashes along the causal spine that connects the given arguments, --- excluding the newest hash (second argument). -loadCausalSpineBetween :: Hash32 -> Hash32 -> Sqlite.Transaction (Maybe [Hash32]) -loadCausalSpineBetween earlierHash laterHash = - dagbfs (== earlierHash) Q.loadCausalParentsByHash laterHash - -data Step a - = DeadEnd - | KeepSearching (List.NonEmpty a) - | FoundGoal a - --- | @dagbfs goal children root@ searches breadth-first through the monadic tree formed by applying @chilred@ to each --- node (initially @root@), until it finds a goal node (i.e. when @goal@ returns True). --- --- Returns the nodes along a path from root to goal in bottom-up or goal-to-root order, excluding the root node (because --- it was provided as an input ;)) --- --- For example, when searching a tree that looks like --- --- 1 --- / \ --- 2 3 --- / \ \ --- 4 [5] 6 --- --- (where the goal is marked [5]), we'd return --- --- Just [5,2] --- --- And (as another example), if the root node is the goal, --- --- [1] --- / \ --- 2 3 --- / \ \ --- 4 5 6 --- --- we'd return --- --- Just [] -dagbfs :: forall a m. (Monad m) => (a -> Bool) -> (a -> m [a]) -> a -> m (Maybe [a]) -dagbfs goal children = - let -- The loop state: all distinct paths from the root to the frontier (not including the root, because it's implied, - -- as an input to this function), in reverse order, with the invariant that we haven't found a goal state yet. - -- (Otherwise, we wouldn't still be in this loop, we'd return!). - -- - -- For example, say we are exploring the tree - -- - -- 1 - -- / \ - -- 2 3 - -- / \ \ - -- 4 5 6 - -- - -- Graphically, the frontier here is the nodes 4, 5, and 6; we know that, because we haven't drawn any nodes below - -- them. (This is a BFS algorithm that discovers children on-the-fly, so maybe node 5 (for example) has children, - -- and maybe it doesn't). - -- - -- The loop state, in this case, would be these three paths: - -- - -- [ 4, 2 ] - -- [ 5, 2 ] - -- [ 6, 3 ] - -- - -- (Note, again, that we do not include the root). - go :: NESeq (List.NonEmpty a) -> m (Maybe (List.NonEmpty a)) - go (path :<|| paths) = - -- Step forward from the first path in our loop state (in the example above, [4, 2]). - step (List.NonEmpty.head path) >>= \case - -- If node 4 had no more children, we can toss that whole path: it didn't end in a goal. Now we either keep - -- searching (as we would in the example, since we have two more paths to continue from), or we don't, because - -- this was the only remaining path. - DeadEnd -> - case NESeq.nonEmptySeq paths of - Nothing -> pure Nothing - Just paths' -> go paths' - -- If node 4 did have children, then maybe the search tree now looks like this. - -- - -- 1 - -- / \ - -- 2 3 - -- / \ \ - -- 4 5 6 - -- / \ - -- 7 8 - -- - -- There are two cases to handle: - -- - -- 1. One of the children we just discovered (say 7) is a goal node. So we're done, and we'd return the path - -- - -- [ 7, 4, 2 ] - -- - -- 2. No child we just discovered (7 nor 8) were a goal node. So we loop, putting our new path(s) at the end - -- of the list (so we search paths fairly). In this case, we'd re-enter the loop with the following four - -- paths: - -- - -- [ 5, 2 ] \ these two are are variable 'paths', the tail of the loop state. - -- [ 6, 3 ] / - -- [ 7, 4, 2 ] \ these two are new, just constructed by prepending each of [ 4, 2, 1 ]'s children - -- [ 8, 4, 2 ] / to itself, making two new paths to search - KeepSearching ys -> go (append paths ((\y -> List.NonEmpty.cons y path) <$> NESeq.fromList ys)) - FoundGoal y -> pure (Just (List.NonEmpty.cons y path)) - - -- Step forward from a single node. There are 3 possible outcomes: - -- - -- 1. We discover it has no children. (return DeadEnd) - -- 2. We discover is has children, none of which are a goal. (return KeepSearching) - -- 3. We discover it has children, (at least) one of which is a goal. (return FoundGoal) - step :: a -> m (Step a) - step x = do - ys0 <- children x - pure case List.NonEmpty.nonEmpty ys0 of - Nothing -> DeadEnd - Just ys -> - case Foldable.find goal ys of - Nothing -> KeepSearching ys - Just y -> FoundGoal y - in \root -> - if goal root - then pure (Just []) - else - step root >>= \case - DeadEnd -> pure Nothing - -- lts-18.28 doesn't have List.NonEmpty.singleton - KeepSearching xs -> fmap List.NonEmpty.toList <$> go (NESeq.fromList ((:| []) <$> xs)) - FoundGoal x -> pure (Just [x]) - where - -- Concatenate a seq and a non-empty seq. - append :: Seq x -> NESeq x -> NESeq x - append = (NESeq.><|) - ------------------------------------------------------------------------------------------------------------------------ -- Pull @@ -977,16 +673,6 @@ httpGetCausalHashByPath :: BaseUrl -> Share.GetCausalHashByPathRequest -> IO (Either CodeserverTransportError Share.GetCausalHashByPathResponse) -httpFastForwardPath :: - Auth.AuthenticatedHttpClient -> - BaseUrl -> - Share.FastForwardPathRequest -> - IO (Either CodeserverTransportError Share.FastForwardPathResponse) -httpUpdatePath :: - Auth.AuthenticatedHttpClient -> - BaseUrl -> - Share.UpdatePathRequest -> - IO (Either CodeserverTransportError Share.UpdatePathResponse) httpDownloadEntities :: Auth.AuthenticatedHttpClient -> BaseUrl -> @@ -998,14 +684,10 @@ httpUploadEntities :: Share.UploadEntitiesRequest -> IO (Either CodeserverTransportError Share.UploadEntitiesResponse) ( httpGetCausalHashByPath, - httpFastForwardPath, - httpUpdatePath, httpDownloadEntities, httpUploadEntities ) = let ( httpGetCausalHashByPath - Servant.:<|> httpFastForwardPath - Servant.:<|> httpUpdatePath Servant.:<|> httpDownloadEntities Servant.:<|> httpUploadEntities ) = @@ -1013,8 +695,6 @@ httpUploadEntities :: pp = Proxy in Servant.hoistClient pp hoist (Servant.client pp) in ( go httpGetCausalHashByPath, - go httpFastForwardPath, - go httpUpdatePath, go httpDownloadEntities, go httpUploadEntities ) @@ -1053,8 +733,10 @@ httpUploadEntities :: { Servant.makeClientRequest = \url request -> -- Disable client-side timeouts (Servant.defaultMakeClientRequest url request) - { Http.Client.responseTimeout = Http.Client.responseTimeoutNone - } + <&> \r -> + r + { Http.Client.responseTimeout = Http.Client.responseTimeoutNone + } } & runReaderT (f req) & runExceptT diff --git a/unison-cli/src/Unison/Share/Sync/Types.hs b/unison-cli/src/Unison/Share/Sync/Types.hs index 1d14c32207..a53d14acbb 100644 --- a/unison-cli/src/Unison/Share/Sync/Types.hs +++ b/unison-cli/src/Unison/Share/Sync/Types.hs @@ -1,8 +1,6 @@ -- | Types used by the UCM client during sync. module Unison.Share.Sync.Types - ( CheckAndSetPushError (..), - CodeserverTransportError (..), - FastForwardPushError (..), + ( CodeserverTransportError (..), GetCausalHashByPathError (..), PullError (..), SyncError (..), @@ -13,29 +11,6 @@ import Servant.Client qualified as Servant import Unison.Prelude import Unison.Sync.Types qualified as Share --- | Error used by the client when pushing code to Unison Share. -data CheckAndSetPushError - = CheckAndSetPushError'UpdatePath - -- The repo we are pushing to. This is only necessary because an UpdatePathError does not have enough context to - -- print the entire error message we want to print, but it really should, at which point maybe this can go away. - Share.RepoInfo - Share.UpdatePathError - | CheckAndSetPushError'UploadEntities Share.UploadEntitiesError - deriving stock (Show) - --- | An error occurred while fast-forward pushing code to Unison Share. -data FastForwardPushError - = FastForwardPushError'FastForwardPath - -- The path we are fast forwarding. This is only necessary because a FastForwardPathError does not have enough - -- context to print the entire error message we want to print, but it really should, at which point maybe this can - -- go away. - Share.Path - Share.FastForwardPathError - | FastForwardPushError'GetCausalHash GetCausalHashByPathError - | FastForwardPushError'NotFastForward Share.Path - | FastForwardPushError'UploadEntities Share.UploadEntitiesError - deriving stock (Show) - -- | An error occurred while pulling code from Unison Share. data PullError = PullError'DownloadEntities Share.DownloadEntitiesError diff --git a/unison-cli/tests/Unison/Test/ClearCache.hs b/unison-cli/tests/Unison/Test/ClearCache.hs index 655bd6d91a..20f5090f2f 100644 --- a/unison-cli/tests/Unison/Test/ClearCache.hs +++ b/unison-cli/tests/Unison/Test/ClearCache.hs @@ -23,7 +23,7 @@ test = scope "clearWatchCache" $ c [i| ```ucm - .> alias.term ##Nat.+ + + scratch/main> alias.term ##Nat.+ + ``` ```unison > 1 + 1 @@ -38,7 +38,7 @@ test = scope "clearWatchCache" $ c [i| ```ucm - .> debug.clear-cache + scratch/main> debug.clear-cache ``` |] diff --git a/unison-cli/tests/Unison/Test/Cli/Monad.hs b/unison-cli/tests/Unison/Test/Cli/Monad.hs index 712b6c083b..ba541e49f8 100644 --- a/unison-cli/tests/Unison/Test/Cli/Monad.hs +++ b/unison-cli/tests/Unison/Test/Cli/Monad.hs @@ -36,12 +36,10 @@ dummyEnv = undefined dummyLoopState :: Cli.LoopState dummyLoopState = Cli.LoopState - { currentPathStack = undefined, - lastInput = Nothing, - lastRunResult = Nothing, - lastSavedRootHash = undefined, + { projectPathStack = undefined, latestFile = Nothing, latestTypecheckedFile = Nothing, + lastInput = Nothing, numberedArgs = [], - root = undefined + lastRunResult = Nothing } diff --git a/unison-cli/tests/Unison/Test/LSP.hs b/unison-cli/tests/Unison/Test/LSP.hs index 5b42467905..880fd6214b 100644 --- a/unison-cli/tests/Unison/Test/LSP.hs +++ b/unison-cli/tests/Unison/Test/LSP.hs @@ -10,6 +10,8 @@ import Data.String.Here.Uninterpolated (here) import Data.Text import Data.Text qualified as Text import EasyTest +import Language.LSP.Protocol.Lens qualified as LSP +import Language.LSP.Protocol.Types qualified as LSP import System.IO.Temp qualified as Temp import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef) @@ -20,6 +22,8 @@ import Unison.Codebase.Init qualified as Codebase.Init import Unison.Codebase.SqliteCodebase qualified as SC import Unison.ConstructorReference (GConstructorReference (..)) import Unison.FileParsers qualified as FileParsers +import Unison.LSP.Conversions qualified as Cv +import Unison.LSP.FileAnalysis.UnusedBindings qualified as UnusedBindings import Unison.LSP.Queries qualified as LSPQ import Unison.Lexer.Pos qualified as Lexer import Unison.Parser.Ann (Ann (..)) @@ -43,6 +47,10 @@ test = do [ refFinding, annotationNesting ] + scope "diagnostics" $ + tests + [ unusedBindingLocations + ] trm :: Term.F Symbol () () (ABT.Term (Term.F Symbol () ()) Symbol ()) -> LSPQ.SourceNode () trm = LSPQ.TermNode . ABT.tm @@ -239,15 +247,39 @@ term = let ) ] --- | Test helper which lets you specify a cursor position inline with source text as a '|'. +-- | Test helper which lets you specify a cursor position inline with source text as a '^'. extractCursor :: Text -> Test (Lexer.Pos, Text) extractCursor txt = - case Text.splitOn "^" txt of + case splitOnDelimiter '^' txt of + Nothing -> crash "expected exactly one cursor" + Just (before, pos, after) -> pure (pos, before <> after) + +-- | Splits a text on a delimiter, returning the text before and after the delimiter, along with the position of the delimiter. +-- +-- >>> splitOnDelimiter '^' "foo b^ar baz" +-- Just ("foo b",Pos {line = 0, column = 5},"ar baz") +splitOnDelimiter :: Char -> Text -> Maybe (Text, Lexer.Pos, Text) +splitOnDelimiter sym txt = + case Text.splitOn (Text.singleton sym) txt of [before, after] -> - let col = Text.length $ Text.takeWhileEnd (/= '\n') before - line = Prelude.length $ Text.lines before - in pure $ (Lexer.Pos line col, before <> after) - _ -> crash "expected exactly one cursor" + let col = (Text.length $ Text.takeWhileEnd (/= '\n') before) + 1 + line = Text.count "\n" before + 1 + in Just $ (before, Lexer.Pos line col, after) + _ -> Nothing + +-- | Test helper which lets you specify a cursor position inline with source text as a '^'. +-- +-- >>> extractDelimitedBlock ('{', '}') "foo {bar} baz" +-- Just (Ann {start = Pos {line = 1, column = 4}, end = Pos {line = 1, column = 7}},"bar","foo bar baz") +-- +-- >>> extractDelimitedBlock ('{', '}') "term =\n {foo} = 12345" +-- Just (Ann {start = Pos {line = 2, column = 2}, end = Pos {line = 2, column = 5}},"foo","term =\n foo = 12345") +extractDelimitedBlock :: (Char, Char) -> Text -> Maybe (Ann {- ann spanning the inside of the delimiters -}, Text {- Text within the delimiters -}, Text {- entire source text with the delimiters stripped -}) +extractDelimitedBlock (startDelim, endDelim) txt = do + (beforeStart, startPos, afterStart) <- splitOnDelimiter startDelim txt + (beforeEnd, endPos, afterEnd) <- splitOnDelimiter endDelim (beforeStart <> afterStart) + let ann = Ann startPos endPos + pure (ann, Text.takeWhile (/= endDelim) afterStart, beforeEnd <> afterEnd) makeNodeSelectionTest :: (String, Text, Bool, LSPQ.SourceNode ()) -> Test () makeNodeSelectionTest (name, testSrc, testTypechecked, expected) = scope name $ do @@ -308,7 +340,7 @@ annotationNestingTest (name, src) = scope name do & traverse_ \(_fileAnn, _refId, _wk, trm, _typ) -> assertAnnotationsAreNested trm --- | Asserts that for all nodes in the provided ABT, the annotations of all child nodes are +-- | Asserts that for all nodes in the provided ABT EXCEPT Abs nodes, the annotations of all child nodes are -- within the span of the parent node. assertAnnotationsAreNested :: forall f. (Foldable f, Functor f, Show (f (Either String Ann))) => ABT.Term f Symbol Ann -> Test () assertAnnotationsAreNested term = do @@ -319,12 +351,19 @@ assertAnnotationsAreNested term = do alg :: Ann -> ABT.ABT f Symbol (Either String Ann) -> Either String Ann alg ann abt = do childSpan <- abt & foldMapM id - case ann `Ann.encompasses` childSpan of - -- one of the annotations isn't in the file, don't bother checking. - Nothing -> pure (ann <> childSpan) - Just isInFile - | isInFile -> pure ann - | otherwise -> Left $ "Containment breach: children aren't contained with the parent:" <> show (ann, abt) + case abt of + -- Abs nodes are the only nodes whose annotations are allowed to not contain their children, + -- they represet the location of the variable being bound instead. Ideally we'd have a separate child + -- node for that, but we can't add it without editing the ABT or Term types. + ABT.Abs _ _ -> + pure (ann <> childSpan) + _ -> do + case ann `Ann.encompasses` childSpan of + -- one of the annotations isn't in the file, don't bother checking. + Nothing -> pure (ann <> childSpan) + Just isInFile + | isInFile -> pure ann + | otherwise -> Left $ "Containment breach: children aren't contained with the parent:" <> show (ann, abt) typecheckSrc :: String -> @@ -374,3 +413,38 @@ withTestCodebase action = do tmpDir <- Temp.createTempDirectory tmp "lsp-test" Codebase.Init.withCreatedCodebase SC.init "lsp-test" tmpDir SC.DontLock action either (crash . show) pure r + +makeDiagnosticRangeTest :: (String, Text) -> Test () +makeDiagnosticRangeTest (testName, testSrc) = scope testName $ do + (ann, _block, cleanSrc) <- case extractDelimitedBlock ('«', '»') testSrc of + Nothing -> crash "expected exactly one delimited block" + Just r -> pure r + (pf, _mayTypecheckedFile) <- typecheckSrc testName cleanSrc + UF.terms pf + & Map.elems + & \case + [(_a, trm)] -> do + case UnusedBindings.analyseTerm (LSP.Uri "test") trm of + [diag] -> do + let expectedRange = Cv.annToRange ann + let actualRange = Just (diag ^. LSP.range) + when (expectedRange /= actualRange) do + crash $ "Expected diagnostic at range: " <> show expectedRange <> ", got: " <> show actualRange + _ -> crash "Expected exactly one diagnostic" + _ -> crash "Expected exactly one term" + +unusedBindingLocations :: Test () +unusedBindingLocations = + scope "unused bindings" . tests . fmap makeDiagnosticRangeTest $ + [ ( "Unused binding in let block", + [here|term = + usedOne = true + «unused = "unused"» + usedTwo = false + usedOne && usedTwo + |] + ), + ( "Unused argument", + [here|term «unused» = 1|] + ) + ] diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs index 54655cfe29..1a8033c52b 100644 --- a/unison-cli/tests/Unison/Test/Ucm.hs +++ b/unison-cli/tests/Unison/Test/Ucm.hs @@ -24,7 +24,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Init qualified as Codebase.Init import Unison.Codebase.Init.CreateCodebaseError (CreateCodebaseError (..)) import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser qualified as TR +import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Parser.Ann (Ann) import Unison.Prelude (traceM) @@ -66,16 +66,16 @@ runTranscript :: Codebase -> Transcript -> IO TranscriptOutput runTranscript (Codebase codebasePath fmt) transcript = do let err e = fail $ "Parse error: \n" <> show e cbInit = case fmt of CodebaseFormat2 -> SC.init - TR.withTranscriptRunner Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ \runner -> do - result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do - Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) - let transcriptSrc = stripMargin . Text.pack $ unTranscript transcript - output <- either err Text.unpack <$> runner "transcript" transcriptSrc (codebasePath, codebase) - when debugTranscriptOutput $ traceM output - pure output - case result of - Left e -> fail $ P.toANSI 80 (P.shown e) - Right x -> pure x + isTest = True + Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ + \runner -> do + result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do + Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) + let transcriptSrc = stripMargin . Text.pack $ unTranscript transcript + output <- either err Text.unpack <$> runner "transcript" transcriptSrc (codebasePath, codebase) + when debugTranscriptOutput $ traceM output + 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 diff --git a/unison-cli/tests/Unison/Test/UriParser.hs b/unison-cli/tests/Unison/Test/UriParser.hs index 1a896f4bae..4c64958f0e 100644 --- a/unison-cli/tests/Unison/Test/UriParser.hs +++ b/unison-cli/tests/Unison/Test/UriParser.hs @@ -8,11 +8,6 @@ import EasyTest import Text.Megaparsec qualified as P import Unison.Codebase.Editor.RemoteRepo ( ReadRemoteNamespace (..), - ShareCodeserver (..), - ShareUserHandle (..), - WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), - pattern ReadShareLooseCode, ) import Unison.Codebase.Editor.UriParser qualified as UriParser import Unison.Codebase.Path qualified as Path @@ -27,8 +22,7 @@ test = [ parserTests "repoPath" (UriParser.readRemoteNamespaceParser ProjectBranchSpecifier'Name <* P.eof) - [ ("unisonweb.base._releases.M4", looseR "unisonweb" ["base", "_releases", "M4"]), - ("project", branchR (This "project")), + [ ("project", branchR (This "project")), ("/branch", branchR (That "branch")), ("project/branch", branchR (These "project" "branch")) ] @@ -36,8 +30,7 @@ test = parserTests "writeRemoteNamespace" (UriParser.writeRemoteNamespace <* P.eof) - [ ("unisonweb.base._releases.M4", looseW "unisonweb" ["base", "_releases", "M4"]), - ("project", branchW (This "project")), + [ ("project", branchW (This "project")), ("/branch", branchW (That "branch")), ("project/branch", branchW (These "project" "branch")) ] @@ -48,14 +41,6 @@ test = mkPath :: [Text] -> Path.Path mkPath = Path.fromList . fmap NameSegment -looseR :: Text -> [Text] -> ReadRemoteNamespace void -looseR user path = - ReadShare'LooseCode (ReadShareLooseCode DefaultCodeserver (ShareUserHandle user) (mkPath path)) - -looseW :: Text -> [Text] -> WriteRemoteNamespace void -looseW user path = - WriteRemoteNamespaceShare (WriteShareRemoteNamespace DefaultCodeserver (ShareUserHandle user) (mkPath path)) - branchR :: These Text Text -> ReadRemoteNamespace (These ProjectName ProjectBranchName) branchR = ReadShare'ProjectBranch . \case @@ -63,9 +48,9 @@ branchR = That branch -> That (UnsafeProjectBranchName branch) These project branch -> These (UnsafeProjectName project) (UnsafeProjectBranchName branch) -branchW :: These Text Text -> WriteRemoteNamespace (These ProjectName ProjectBranchName) +branchW :: These Text Text -> (These ProjectName ProjectBranchName) branchW = - WriteRemoteProjectBranch . \case + \case This project -> This (UnsafeProjectName project) That branch -> That (UnsafeProjectBranchName branch) These project branch -> These (UnsafeProjectName project) (UnsafeProjectBranchName branch) diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 56a3394086..77220a3061 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/unison-cli/transcripts/Transcripts.hs @@ -22,9 +22,10 @@ import System.FilePath ) import System.IO.CodePage (withCP65001) import System.IO.Silently (silence) +import Text.Megaparsec qualified as MP import Unison.Codebase.Init (withTemporaryUcmCodebase) import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser (TranscriptError (..), withTranscriptRunner) +import Unison.Codebase.Transcript.Runner as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Prelude import UnliftIO.STM qualified as STM @@ -47,7 +48,8 @@ testBuilder :: Test () testBuilder expectFailure recordFailure runtimePath dir prelude transcript = scope transcript $ do outputs <- io . withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock $ \(codebasePath, codebase) -> do - withTranscriptRunner Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do + let isTest = True + Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do for files \filePath -> do transcriptSrc <- readUtf8 filePath out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase) @@ -56,12 +58,12 @@ testBuilder expectFailure recordFailure runtimePath dir prelude transcript = sco (filePath, Left err) -> do let outputFile = outputFileForTranscript filePath case err of - TranscriptParseError msg -> do + Transcript.ParseError errors -> do when (not expectFailure) $ do - let errMsg = "Error parsing " <> filePath <> ": " <> Text.unpack msg + let errMsg = "Error parsing " <> filePath <> ": " <> MP.errorBundlePretty errors io $ recordFailure (filePath, Text.pack errMsg) crash errMsg - TranscriptRunFailure errOutput -> do + Transcript.RunFailure errOutput -> do io $ writeUtf8 outputFile errOutput when (not expectFailure) $ do io $ Text.putStrLn errOutput diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index d530ed68b2..77030bfdf6 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -47,7 +47,6 @@ library Unison.Cli.Share.Projects.Types Unison.Cli.TypeCheck Unison.Cli.UniqueTypeGuidLookup - Unison.Cli.UnisonConfigUtils Unison.Codebase.Editor.AuthorInfo Unison.Codebase.Editor.HandleInput Unison.Codebase.Editor.HandleInput.AddRun @@ -59,6 +58,7 @@ library Unison.Codebase.Editor.HandleInput.CommitUpgrade Unison.Codebase.Editor.HandleInput.DebugDefinition Unison.Codebase.Editor.HandleInput.DebugFoldRanges + Unison.Codebase.Editor.HandleInput.DebugSynhashTerm Unison.Codebase.Editor.HandleInput.DeleteBranch Unison.Codebase.Editor.HandleInput.DeleteProject Unison.Codebase.Editor.HandleInput.EditNamespace @@ -66,6 +66,8 @@ library Unison.Codebase.Editor.HandleInput.FormatFile Unison.Codebase.Editor.HandleInput.InstallLib Unison.Codebase.Editor.HandleInput.Load + Unison.Codebase.Editor.HandleInput.Ls + Unison.Codebase.Editor.HandleInput.LSPDebug Unison.Codebase.Editor.HandleInput.Merge2 Unison.Codebase.Editor.HandleInput.MoveAll Unison.Codebase.Editor.HandleInput.MoveBranch @@ -80,12 +82,14 @@ library Unison.Codebase.Editor.HandleInput.ProjectSwitch Unison.Codebase.Editor.HandleInput.Pull Unison.Codebase.Editor.HandleInput.Push + Unison.Codebase.Editor.HandleInput.Reflogs Unison.Codebase.Editor.HandleInput.ReleaseDraft Unison.Codebase.Editor.HandleInput.Run Unison.Codebase.Editor.HandleInput.RuntimeUtils Unison.Codebase.Editor.HandleInput.ShowDefinition Unison.Codebase.Editor.HandleInput.TermResolution Unison.Codebase.Editor.HandleInput.Tests + Unison.Codebase.Editor.HandleInput.Todo Unison.Codebase.Editor.HandleInput.UI Unison.Codebase.Editor.HandleInput.Update Unison.Codebase.Editor.HandleInput.Update2 @@ -100,10 +104,11 @@ library Unison.Codebase.Editor.SlurpComponent Unison.Codebase.Editor.SlurpResult Unison.Codebase.Editor.StructuredArgument - Unison.Codebase.Editor.TodoOutput Unison.Codebase.Editor.UCMVersion Unison.Codebase.Editor.UriParser - Unison.Codebase.TranscriptParser + Unison.Codebase.Transcript + Unison.Codebase.Transcript.Parser + Unison.Codebase.Transcript.Runner Unison.Codebase.Watch Unison.CommandLine Unison.CommandLine.BranchRelativePath @@ -111,6 +116,7 @@ library Unison.CommandLine.DisplayValues Unison.CommandLine.FuzzySelect Unison.CommandLine.FZFResolvers + Unison.CommandLine.Helpers Unison.CommandLine.InputPattern Unison.CommandLine.InputPatterns Unison.CommandLine.Main @@ -127,6 +133,7 @@ library Unison.LSP.Conversions Unison.LSP.Diagnostics Unison.LSP.FileAnalysis + Unison.LSP.FileAnalysis.UnusedBindings Unison.LSP.FoldingRange Unison.LSP.Formatting Unison.LSP.HandlerUtils @@ -136,6 +143,7 @@ library Unison.LSP.Queries Unison.LSP.Types Unison.LSP.UCMWorker + Unison.LSP.Util.Signal Unison.LSP.VFS Unison.Main Unison.Share.Codeserver @@ -191,6 +199,7 @@ library , base , bytes , bytestring + , cmark , co-log-core , code-page , concurrent-output @@ -226,6 +235,7 @@ library , network-udp , network-uri , nonempty-containers + , numerals , open-browser , optparse-applicative >=0.16.1.0 , pretty-simple @@ -265,7 +275,6 @@ library , unison-sqlite , unison-syntax , unison-util-base32hex - , unison-util-nametree , unison-util-relation , unliftio , unordered-containers @@ -332,6 +341,7 @@ executable transcripts , base , bytes , bytestring + , cmark , co-log-core , code-page , concurrent-output @@ -368,6 +378,7 @@ executable transcripts , network-udp , network-uri , nonempty-containers + , numerals , open-browser , optparse-applicative >=0.16.1.0 , pretty-simple @@ -409,7 +420,6 @@ executable transcripts , unison-sqlite , unison-syntax , unison-util-base32hex - , unison-util-nametree , unison-util-relation , unliftio , unordered-containers @@ -480,6 +490,7 @@ test-suite cli-tests , base , bytes , bytestring + , cmark , co-log-core , code-page , concurrent-output @@ -517,6 +528,7 @@ test-suite cli-tests , network-udp , network-uri , nonempty-containers + , numerals , open-browser , optparse-applicative >=0.16.1.0 , pretty-simple @@ -557,7 +569,6 @@ test-suite cli-tests , unison-sqlite , unison-syntax , unison-util-base32hex - , unison-util-nametree , unison-util-relation , unliftio , unordered-containers diff --git a/unison-core/package.yaml b/unison-core/package.yaml index 210367d234..2b8bea50bf 100644 --- a/unison-core/package.yaml +++ b/unison-core/package.yaml @@ -24,6 +24,8 @@ library: - mtl - rfc5051 - safe + - semialign + - semigroups - text - text-builder - these @@ -54,7 +56,7 @@ tests: source-dirs: test default-extensions: - - ApplicativeDo + - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFoldable @@ -62,17 +64,21 @@ default-extensions: - DeriveGeneric - DeriveTraversable - DerivingStrategies + - DerivingVia - DoAndIfThenElse + - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost + - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - NamedFieldPuns - OverloadedStrings + - OverloadedRecordDot - PatternSynonyms - RankNTypes - ScopedTypeVariables diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index b6c9776dc7..513759ac07 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -52,7 +52,7 @@ import Unison.Prelude import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent' +import Unison.ReferentPrime qualified as Referent' import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Var (Var) diff --git a/unison-core/src/Unison/DataDeclaration/Records.hs b/unison-core/src/Unison/DataDeclaration/Records.hs index ac12dfb08c..cdbd13fa3e 100644 --- a/unison-core/src/Unison/DataDeclaration/Records.hs +++ b/unison-core/src/Unison/DataDeclaration/Records.hs @@ -41,7 +41,7 @@ generateRecordAccessors namespaced generatedAnn fields typename typ = -- point -> case point of Point _ y _ -> y get = - Term.lam ann argname $ + Term.lam ann (ann, argname) $ Term.match ann (Term.var ann argname) @@ -57,7 +57,7 @@ generateRecordAccessors namespaced generatedAnn fields typename typ = -- y' point -> case point of Point x _ z -> Point x y' z set = - Term.lam' ann [fname', argname] $ + Term.lam' ann [(ann, fname'), (ann, argname)] $ Term.match ann (Term.var ann argname) @@ -86,7 +86,7 @@ generateRecordAccessors namespaced generatedAnn fields typename typ = -- example: `f point -> case point of Point x y z -> Point x (f y) z` modify = - Term.lam' ann [fname', argname] $ + Term.lam' ann [(ann, fname'), (ann, argname)] $ Term.match ann (Term.var ann argname) diff --git a/unison-core/src/Unison/HashQualified'.hs b/unison-core/src/Unison/HashQualifiedPrime.hs similarity index 99% rename from unison-core/src/Unison/HashQualified'.hs rename to unison-core/src/Unison/HashQualifiedPrime.hs index b1ea8c1deb..19c341f4d6 100644 --- a/unison-core/src/Unison/HashQualified'.hs +++ b/unison-core/src/Unison/HashQualifiedPrime.hs @@ -1,4 +1,4 @@ -module Unison.HashQualified' where +module Unison.HashQualifiedPrime where import Data.Text qualified as Text import Unison.HashQualified qualified as HQ diff --git a/unison-core/src/Unison/Hashable.hs b/unison-core/src/Unison/Hashable.hs index b0d32ce2a9..69f7173bef 100644 --- a/unison-core/src/Unison/Hashable.hs +++ b/unison-core/src/Unison/Hashable.hs @@ -31,6 +31,7 @@ data Token h | Double !Double | Hashed !h | Nat !Word64 + deriving stock (Show) class Accumulate h where accumulate :: [Token h] -> h diff --git a/unison-core/src/Unison/Name/Internal.hs b/unison-core/src/Unison/Name/Internal.hs index 3272d43df1..4e00652456 100644 --- a/unison-core/src/Unison/Name/Internal.hs +++ b/unison-core/src/Unison/Name/Internal.hs @@ -33,10 +33,10 @@ import Unison.Util.Alphabetical -- - ".." --> Name Absolute (".." :| []) data Name = Name + -- | whether the name is positioned absolutely (to some arbitrary root namespace), or relatively Position - -- ^ whether the name is positioned absolutely (to some arbitrary root namespace), or relatively + -- | the name segments in reverse order (List.NonEmpty NameSegment) - -- ^ the name segments in reverse order deriving stock (Eq, Generic, Show) -- | Compare names (kinda) alphabetically: absolute comes before relative, but otherwise compare the name segments @@ -49,10 +49,11 @@ instance Alphabetical Name where _ -> compareAlphabetical (segments n1) (segments n2) instance - TypeError - ( 'TypeError.Text - "You cannot make a Name from a string literal because there may (some day) be more than one syntax" - ) => + ( TypeError + ( 'TypeError.Text + "You cannot make a Name from a string literal because there may (some day) be more than one syntax" + ) + ) => IsString Name where fromString = undefined diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index b21b761927..9b8c2af8ee 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -49,21 +49,25 @@ module Unison.Names hashQualifyTypesRelation, hashQualifyTermsRelation, fromTermsAndTypes, + lenientToNametree, ) where import Data.Map qualified as Map +import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.Text qualified as Text +import Data.These (These (..)) import Text.FuzzyFind qualified as FZF import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference @@ -71,6 +75,10 @@ import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Nametree (Nametree, unflattenNametree) import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as R import Unison.Util.Relation qualified as Relation @@ -95,7 +103,7 @@ instance Monoid (Names) where mempty = Names mempty mempty isEmpty :: Names -> Bool -isEmpty n = R.null (terms n) && R.null (types n) +isEmpty n = R.null n.terms && R.null n.types map :: (Name -> Name) -> Names -> Names map f (Names {terms, types}) = Names terms' types' @@ -122,8 +130,8 @@ fuzzyFind nameToText query names = . Prelude.filter prefilter . Map.toList -- `mapMonotonic` is safe here and saves a log n factor - $ (Set.mapMonotonic Left <$> R.toMultimap (terms names)) - <> (Set.mapMonotonic Right <$> R.toMultimap (types names)) + $ (Set.mapMonotonic Left <$> R.toMultimap names.terms) + <> (Set.mapMonotonic Right <$> R.toMultimap names.types) where lowerqueryt = Text.toLower . Text.pack <$> query -- For performance, case-insensitive substring matching as a pre-filter @@ -250,8 +258,8 @@ unionLeft' :: Names unionLeft' shouldOmit a b = Names terms' types' where - terms' = foldl' go (terms a) (R.toList $ terms b) - types' = foldl' go (types a) (R.toList $ types b) + terms' = foldl' go a.terms (R.toList b.terms) + types' = foldl' go a.types (R.toList b.types) go :: (Ord a, Ord b) => Relation a b -> (a, b) -> Relation a b go acc (n, r) = if shouldOmit n r acc then acc else R.insert n r acc @@ -260,7 +268,7 @@ numHashChars :: Int numHashChars = 3 termsNamed :: Names -> Name -> Set Referent -termsNamed = flip R.lookupDom . terms +termsNamed = flip R.lookupDom . (.terms) -- | Get all terms with a specific name. refTermsNamed :: Names -> Name -> Set TermReference @@ -281,13 +289,13 @@ refTermsHQNamed names = \case in Set.mapMaybe f (termsNamed names name) typesNamed :: Names -> Name -> Set TypeReference -typesNamed = flip R.lookupDom . types +typesNamed = flip R.lookupDom . (.types) namesForReferent :: Names -> Referent -> Set Name -namesForReferent names r = R.lookupRan r (terms names) +namesForReferent names r = R.lookupRan r names.terms namesForReference :: Names -> TypeReference -> Set Name -namesForReference names r = R.lookupRan r (types names) +namesForReference names r = R.lookupRan r names.types termAliases :: Names -> Name -> Referent -> Set Name termAliases names n r = Set.delete n $ namesForReferent names r @@ -422,20 +430,20 @@ filterTypes f (Names terms types) = Names terms (R.filterDom f types) difference :: Names -> Names -> Names difference a b = Names - (R.difference (terms a) (terms b)) - (R.difference (types a) (types b)) + (R.difference a.terms b.terms) + (R.difference a.types b.types) contains :: Names -> Reference -> Bool contains names = -- We want to compute `termsReferences` only once, if `contains` is partially applied to a `Names`, and called over -- and over for different references. GHC would probably float `termsReferences` out without the explicit lambda, but -- it's written like this just to be sure. - \r -> Set.member r termsReferences || R.memberRan r (types names) + \r -> Set.member r termsReferences || R.memberRan r names.types where -- this check makes `contains` O(n) instead of O(log n) termsReferences :: Set TermReference termsReferences = - Set.map Referent.toReference (R.ran (terms names)) + Set.map Referent.toReference (R.ran names.terms) -- | filters out everything from the domain except what's conflicted conflicts :: Names -> Names @@ -448,9 +456,9 @@ conflicts Names {..} = Names (R.filterManyDom terms) (R.filterManyDom types) -- See usage in `FileParser` for handling precendence of symbol -- resolution where local names are preferred to codebase names. shadowTerms :: [Name] -> Names -> Names -shadowTerms ns n0 = Names terms' (types n0) +shadowTerms ns n0 = Names terms' n0.types where - terms' = foldl' go (terms n0) ns + terms' = foldl' go n0.terms ns go ts name = R.deleteDom name ts -- | Given a mapping from name to qualified name, update a `Names`, @@ -461,8 +469,8 @@ shadowTerms ns n0 = Names terms' (types n0) importing :: [(Name, Name)] -> Names -> Names importing shortToLongName ns = Names - (foldl' go (terms ns) shortToLongName) - (foldl' go (types ns) shortToLongName) + (foldl' go ns.terms shortToLongName) + (foldl' go ns.types shortToLongName) where go :: (Ord r) => Relation Name r -> (Name, Name) -> Relation Name r go m (shortname, qname) = case Name.searchByRankedSuffix qname m of @@ -476,8 +484,8 @@ importing shortToLongName ns = -- `[(foo, io.foo), (bar, io.bar)]`. expandWildcardImport :: Name -> Names -> [(Name, Name)] expandWildcardImport prefix ns = - [(suffix, full) | Just (suffix, full) <- go <$> R.toList (terms ns)] - <> [(suffix, full) | Just (suffix, full) <- go <$> R.toList (types ns)] + [(suffix, full) | Just (suffix, full) <- go <$> R.toList ns.terms] + <> [(suffix, full) | Just (suffix, full) <- go <$> R.toList ns.types] where go :: (Name, a) -> Maybe (Name, Name) go (full, _) = do @@ -498,7 +506,7 @@ constructorsForType r ns = possibleDatas = [Referent.Con (ConstructorReference r cid) CT.Data | cid <- [0 ..]] possibleEffects = [Referent.Con (ConstructorReference r cid) CT.Effect | cid <- [0 ..]] trim [] = [] - trim (h : t) = case R.lookupRan h (terms ns) of + trim (h : t) = case R.lookupRan h ns.terms of s | Set.null s -> [] | otherwise -> [(n, h) | n <- toList s] ++ trim t @@ -517,3 +525,29 @@ hashQualifyRelation fromNamedRef rel = R.map go rel if Set.size (R.lookupDom n rel) > 1 then (HQ.take numHashChars $ fromNamedRef n r, r) else (HQ.NameOnly n, r) + +-- | "Leniently" view a Names as a NameTree +-- +-- This function is "lenient" in the sense that it does not handle conflicted names with any smarts whatsoever. The +-- resulting nametree will simply contain one of the associated references of a conflicted name - we don't specify +-- which. +lenientToNametree :: Names -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) +lenientToNametree names = + alignWith + ( \case + This terms -> Defns {terms, types = Map.empty} + That types -> Defns {terms = Map.empty, types} + These terms types -> Defns {terms, types} + ) + (lenientRelationToNametree names.terms) + (lenientRelationToNametree names.types) + where + lenientRelationToNametree :: (Ord a) => Relation Name a -> Nametree (Map NameSegment a) + lenientRelationToNametree = + unflattenNametree . lenientRelationToLeftUniqueRelation + + lenientRelationToLeftUniqueRelation :: (Ord a, Ord b) => Relation a b -> BiMultimap b a + lenientRelationToLeftUniqueRelation = + -- The partial `Set.findMin` are fine here because Relation.domain only has non-empty Set values. A NESet would be + -- better. + BiMultimap.fromRange . Map.map Set.findMin . Relation.domain diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index 7e2d126ec4..561fa557f8 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -34,7 +34,7 @@ import Unison.ConstructorReference (ConstructorReference) import Unison.ConstructorType qualified as CT import Unison.HashQualified (HashQualified) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names (..)) diff --git a/unison-core/src/Unison/Project.hs b/unison-core/src/Unison/Project.hs index 77a96a448a..73070e7a1d 100644 --- a/unison-core/src/Unison/Project.hs +++ b/unison-core/src/Unison/Project.hs @@ -17,6 +17,7 @@ module Unison.Project ProjectBranchSpecifier (..), ProjectAndBranch (..), projectAndBranchNamesParser, + fullyQualifiedProjectAndBranchNamesParser, projectAndOptionalBranchParser, branchWithOptionalProjectParser, ProjectAndBranchNames (..), @@ -414,6 +415,20 @@ projectAndBranchNamesParser specifier = do Just branch -> These project branch else pure (This project) +-- | Parse a fully specified myproject/mybranch name. +-- +-- >>> import Text.Megaparsec (parseMaybe) +-- >>> parseMaybe fullyQualifiedProjectAndBranchNamesParser ("myproject/mybranch" :: Text) +-- Just (ProjectAndBranch {project = UnsafeProjectName "myproject", branch = UnsafeProjectBranchName "mybranch"}) +fullyQualifiedProjectAndBranchNamesParser :: Megaparsec.Parsec Void Text (ProjectAndBranch ProjectName ProjectBranchName) +fullyQualifiedProjectAndBranchNamesParser = do + (project, hadSlash) <- projectNameParser + if hadSlash + then pure () + else void $ Megaparsec.char '/' + branch <- projectBranchNameParser False + pure (ProjectAndBranch project branch) + -- | @project/branch@ syntax, where the branch is optional. instance From (ProjectAndBranch ProjectName (Maybe ProjectBranchName)) Text where from = \case diff --git a/unison-core/src/Unison/Referent.hs b/unison-core/src/Unison/Referent.hs index d04454ea17..104a88e6f0 100644 --- a/unison-core/src/Unison/Referent.hs +++ b/unison-core/src/Unison/Referent.hs @@ -41,7 +41,7 @@ import Unison.Prelude hiding (fold) import Unison.Reference (Reference, TermReference, TermReferenceId) import Unison.Reference qualified as R import Unison.Reference qualified as Reference -import Unison.Referent' (Referent' (..), reference_, toReference') +import Unison.ReferentPrime (Referent' (..), reference_, toReference') import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH diff --git a/unison-core/src/Unison/Referent'.hs b/unison-core/src/Unison/ReferentPrime.hs similarity index 96% rename from unison-core/src/Unison/Referent'.hs rename to unison-core/src/Unison/ReferentPrime.hs index b65b75e09d..a51aff374f 100644 --- a/unison-core/src/Unison/Referent'.hs +++ b/unison-core/src/Unison/ReferentPrime.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} -module Unison.Referent' +module Unison.ReferentPrime ( Referent' (..), -- * Basic queries isConstructor, - Unison.Referent'.fold, + Unison.ReferentPrime.fold, -- * Lenses reference_, diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 73df6fc3ae..5a3ea2127a 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -397,7 +397,7 @@ substTypeVar vt ty = go Set.empty t2 = ABT.bindInheritAnnotation body (Type.var () v2) in uncapture ((ABT.annotation t, v2) : vs) (renameTypeVar v v2 e) t2 uncapture vs e t0 = - let t = foldl (\body (loc, v) -> Type.forall loc v body) t0 vs + let t = foldl (\body (loc, v) -> Type.forAll loc v body) t0 vs bound' = case Type.unForalls (Type.stripIntroOuters t) of Nothing -> bound Just (vs, _) -> bound <> Set.fromList vs @@ -866,20 +866,40 @@ ann :: Term2 vt at ap v a ann a e t = ABT.tm' a (Ann e t) --- arya: are we sure we want the two annotations to be the same? -lam :: (Ord v) => a -> v -> Term2 vt at ap v a -> Term2 vt at ap v a -lam a v body = ABT.tm' a (Lam (ABT.abs' a v body)) +-- | Add a lambda with a single argument. +lam :: + (Ord v) => + -- | Annotation of the whole lambda + a -> + -- Annotation of just the arg binding + (a, v) -> + Term2 vt at ap v a -> + Term2 vt at ap v a +lam spanAnn (bindingAnn, v) body = ABT.tm' spanAnn (Lam (ABT.abs' bindingAnn v body)) + +-- | Add a lambda with a list of arguments. +lam' :: + (Ord v) => + -- | Annotation of the whole lambda + a -> + [(a {- Annotation of the arg binding -}, v)] -> + Term2 vt at ap v a -> + Term2 vt at ap v a +lam' a vs body = foldr (lam a) body vs + +-- | Only use this variant if you don't have source annotations for the binding arguments available. +lamWithoutBindingAnns :: + (Ord v) => + a -> + [v] -> + Term2 vt at ap v a -> + Term2 vt at ap v a +lamWithoutBindingAnns a vs body = lam' a ((a,) <$> vs) body delay :: (Var v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a delay a body = ABT.tm' a (Lam (ABT.abs' a (ABT.freshIn (ABT.freeVars body) (Var.typed Var.Delay)) body)) -lam' :: (Ord v) => a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a -lam' a vs body = foldr (lam a) body vs - -lam'' :: (Ord v) => [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a -lam'' vs body = foldr (uncurry lam) body vs - isLam :: Term2 vt at ap v a -> Bool isLam t = arity t > 0 @@ -947,7 +967,7 @@ letRec isTop blockAnn bindings e = (foldr addAbs body bindings) where addAbs :: ((a, v), b) -> ABT.Term f v a -> ABT.Term f v a - addAbs ((_a, v), _b) t = ABT.abs' blockAnn v t + addAbs ((a, v), _b) t = ABT.abs' a v t body :: Term' vt v a body = ABT.tm' blockAnn (LetRec isTop (map snd bindings) e) @@ -978,7 +998,7 @@ let1 :: Term2 vt at ap v a let1 isTop bindings e = foldr f e bindings where - f ((ann, v), b) body = ABT.tm' (ann <> ABT.annotation body) (Let isTop b (ABT.abs' (ABT.annotation body) v body)) + f ((ann, v), b) body = ABT.tm' (ann <> ABT.annotation body) (Let isTop b (ABT.abs' ann v body)) let1' :: (Semigroup a, Ord v) => @@ -997,12 +1017,14 @@ let1' isTop bindings e = foldr f e bindings singleLet :: (Ord v) => IsTop -> - -- Annotation spanning the whole let-binding + -- Annotation spanning the let-binding and its body + a -> + -- Annotation for just the binding, not the body it's used in. a -> (v, Term2 vt at ap v a) -> Term2 vt at ap v a -> Term2 vt at ap v a -singleLet isTop a (v, body) e = ABT.tm' a (Let isTop body (ABT.abs' a v e)) +singleLet isTop spanAnn absAnn (v, body) e = ABT.tm' spanAnn (Let isTop body (ABT.abs' absAnn v e)) -- let1' :: Var v => [(Text, Term0 vt v)] -> Term0 vt v -> Term0 vt v -- let1' bs e = let1 [(ABT.v' name, b) | (name,b) <- bs ] e @@ -1323,7 +1345,7 @@ betaNormalForm e = e -- x -> f x => f etaNormalForm :: (Ord v) => Term0 v -> Term0 v etaNormalForm tm = case tm of - LamNamed' v body -> step . lam (ABT.annotation tm) v $ etaNormalForm body + LamNamed' v body -> step . lam () ((), v) $ etaNormalForm body where step (LamNamed' v (App' f (Var' v'))) | v == v', v `Set.notMember` freeVars f = f @@ -1333,7 +1355,7 @@ etaNormalForm tm = case tm of -- x -> f x => f as long as `x` is a variable of type `Var.Eta` etaReduceEtaVars :: (Var v) => Term0 v -> Term0 v etaReduceEtaVars tm = case tm of - LamNamed' v body -> step . lam (ABT.annotation tm) v $ etaReduceEtaVars body + LamNamed' v body -> step . lam (ABT.annotation tm) ((), v) $ etaReduceEtaVars body where ok v v' f = v == v' @@ -1383,7 +1405,7 @@ containsExpression = ABT.containsExpression -- Used to find matches of `@rewrite case` rules -- Returns `Nothing` if `pat` can't be interpreted as a `Pattern` -- (like `1 + 1` is not a valid pattern, but `Some x` can be) -containsCaseTerm :: Var v1 => Term2 tv ta tb v1 loc -> Term2 typeVar typeAnn loc v2 a -> Maybe Bool +containsCaseTerm :: (Var v1) => Term2 tv ta tb v1 loc -> Term2 typeVar typeAnn loc v2 a -> Maybe Bool containsCaseTerm pat = (\tm -> containsCase <$> pat' <*> pure tm) where @@ -1456,7 +1478,7 @@ rewriteCasesLHS pat0 pat0' = go t = t -- Implementation detail of `@rewrite case` rules (both find and replace) -toPattern :: Var v => Term2 tv ta tb v loc -> Maybe (Pattern loc) +toPattern :: (Var v) => Term2 tv ta tb v loc -> Maybe (Pattern loc) toPattern tm = case tm of Var' v | "_" `Text.isPrefixOf` Var.name v -> pure $ Pattern.Unbound loc Var' _ -> pure $ Pattern.Var loc @@ -1484,7 +1506,7 @@ toPattern tm = case tm of loc = ABT.annotation tm -- Implementation detail of `@rewrite case` rules (both find and replace) -matchCaseFromTerm :: Var v => Term2 typeVar typeAnn a v a -> Maybe (MatchCase a (Term2 typeVar typeAnn a v a)) +matchCaseFromTerm :: (Var v) => Term2 typeVar typeAnn a v a -> Maybe (MatchCase a (Term2 typeVar typeAnn a v a)) matchCaseFromTerm (App' (Builtin' "#case") (ABT.unabsA -> (_, Apps' _ci [pat, guard, body]))) = do p <- toPattern pat let g = unguard guard diff --git a/unison-core/src/Unison/Type.hs b/unison-core/src/Unison/Type.hs index 4e571ff761..d779aa7ce1 100644 --- a/unison-core/src/Unison/Type.hs +++ b/unison-core/src/Unison/Type.hs @@ -451,28 +451,28 @@ arrow' i o = arrow (ABT.annotation i <> ABT.annotation o) i o ann :: (Ord v) => a -> Type v a -> K.Kind -> Type v a ann a e t = ABT.tm' a (Ann e t) -forall :: (Ord v) => a -> v -> Type v a -> Type v a -forall a v body = ABT.tm' a (Forall (ABT.abs' a v body)) +forAll :: (Ord v) => a -> v -> Type v a -> Type v a +forAll a v body = ABT.tm' a (Forall (ABT.abs' a v body)) introOuter :: (Ord v) => a -> v -> Type v a -> Type v a introOuter a v body = ABT.tm' a (IntroOuter (ABT.abs' a v body)) iff :: (Var v) => Type v () -iff = forall () aa $ arrows (f <$> [boolean (), a, a]) a +iff = forAll () aa $ arrows (f <$> [boolean (), a, a]) a where aa = Var.named "a" a = var () aa f x = ((), x) iff' :: (Var v) => a -> Type v a -iff' loc = forall loc aa $ arrows (f <$> [boolean loc, a, a]) a +iff' loc = forAll loc aa $ arrows (f <$> [boolean loc, a, a]) a where aa = Var.named "a" a = var loc aa f x = (loc, x) iff2 :: (Var v) => a -> Type v a -iff2 loc = forall loc aa $ arrows (f <$> [a, a]) a +iff2 loc = forAll loc aa $ arrows (f <$> [a, a]) a where aa = Var.named "a" a = var loc aa @@ -498,11 +498,11 @@ v' s = ABT.var (Var.named s) av' :: (Var v) => a -> Text -> Type v a av' a s = ABT.annotatedVar a (Var.named s) -forall' :: (Var v) => a -> [Text] -> Type v a -> Type v a -forall' a vs body = foldr (forall a) body (Var.named <$> vs) +forAll' :: (Var v) => a -> [Text] -> Type v a -> Type v a +forAll' a vs body = foldr (forAll a) body (Var.named <$> vs) foralls :: (Ord v) => a -> [v] -> Type v a -> Type v a -foralls a vs body = foldr (forall a) body vs +foralls a vs body = foldr (forAll a) body vs -- Note: `a -> b -> c` parses as `a -> (b -> c)` -- the annotation associated with `b` will be the annotation for the `b -> c` @@ -545,7 +545,7 @@ stripEffect t = ([], t) -- The type of the flipped function application operator: -- `(a -> (a -> b) -> b)` flipApply :: (Var v) => Type v () -> Type v () -flipApply t = forall () b $ arrow () (arrow () t (var () b)) (var () b) +flipApply t = forAll () b $ arrow () (arrow () t (var () b)) (var () b) where b = ABT.fresh t (Var.named "b") @@ -554,12 +554,12 @@ generalize' k t = generalize vsk t where vsk = [v | v <- Set.toList (freeVars t), Var.typeOf v == k] --- | Bind the given variables with an outer `forall`, if they are used in `t`. +-- | Bind the given variables with an outer `forAll`, if they are used in `t`. generalize :: (Ord v) => [v] -> Type v a -> Type v a generalize vs t = foldr f t vs where f v t = - if Set.member v (ABT.freeVars t) then forall (ABT.annotation t) v t else t + if Set.member v (ABT.freeVars t) then forAll (ABT.annotation t) v t else t unforall :: Type v a -> Type v a unforall (ForallsNamed' _ t) = t @@ -755,7 +755,7 @@ functionResult = go False -- `.foo -> .foo` becomes `.foo -> .foo` (not changed) -- `.foo.bar -> blarrg.woot` becomes `.foo.bar -> blarrg.woot` (unchanged) generalizeLowercase :: (Var v) => Set v -> Type v a -> Type v a -generalizeLowercase except t = foldr (forall (ABT.annotation t)) t vars +generalizeLowercase except t = foldr (forAll (ABT.annotation t)) t vars where vars = [v | v <- Set.toList (ABT.freeVars t `Set.difference` except), Var.universallyQuantifyIfFree v] @@ -774,7 +774,7 @@ normalizeForallOrder tm0 = where step :: (a, v) -> Type v a -> Type v a step (a, v) body - | Set.member v (ABT.freeVars body) = forall a v body + | Set.member v (ABT.freeVars body) = forAll a v body | otherwise = body (body, vs0) = extract tm0 vs = sortOn (\(_, v) -> Map.lookup v ind) vs0 diff --git a/lib/unison-util-nametree/src/Unison/Util/Defns.hs b/unison-core/src/Unison/Util/Defns.hs similarity index 95% rename from lib/unison-util-nametree/src/Unison/Util/Defns.hs rename to unison-core/src/Unison/Util/Defns.hs index 9dde575531..e61c5ba7bb 100644 --- a/lib/unison-util-nametree/src/Unison/Util/Defns.hs +++ b/unison-core/src/Unison/Util/Defns.hs @@ -28,7 +28,7 @@ data Defns terms types = Defns { terms :: terms, types :: types } - deriving stock (Generic, Show) + deriving stock (Generic, Functor, Show) deriving (Monoid, Semigroup) via GenericSemigroupMonoid (Defns terms types) instance Bifoldable Defns where @@ -56,7 +56,7 @@ type DefnsF3 f g h terms types = type DefnsF4 f g h i terms types = Defns (f (g (h (i terms)))) (f (g (h (i types)))) -alignDefnsWith :: Semialign f => (These a b -> c) -> Defns (f a) (f b) -> f c +alignDefnsWith :: (Semialign f) => (These a b -> c) -> Defns (f a) (f b) -> f c alignDefnsWith f defns = alignWith f defns.terms defns.types diff --git a/lib/unison-util-nametree/src/Unison/Util/Nametree.hs b/unison-core/src/Unison/Util/Nametree.hs similarity index 95% rename from lib/unison-util-nametree/src/Unison/Util/Nametree.hs rename to unison-core/src/Unison/Util/Nametree.hs index 18a6ba3769..a1f52e3316 100644 --- a/lib/unison-util-nametree/src/Unison/Util/Nametree.hs +++ b/unison-core/src/Unison/Util/Nametree.hs @@ -49,7 +49,7 @@ instance Unzip Nametree where (ys, zs) = unzipWith (unzipWith f) xs -- | Traverse over a nametree, with access to the list of name segments (in reverse order) leading to each value. -traverseNametreeWithName :: Applicative f => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) +traverseNametreeWithName :: (Applicative f) => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) traverseNametreeWithName f = go [] where @@ -81,7 +81,7 @@ unfoldNametree f x = -- > } flattenNametree :: forall a b. - Ord b => + (Ord b) => (a -> Map NameSegment b) -> Nametree a -> BiMultimap b Name @@ -120,7 +120,7 @@ flattenNametree f = -- > "baz" = #baz -- > } -- > } -unflattenNametree :: Ord a => BiMultimap a Name -> Nametree (Map NameSegment a) +unflattenNametree :: (Ord a) => BiMultimap a Name -> Nametree (Map NameSegment a) unflattenNametree = unfoldNametree unflattenLevel . map (first Name.segments) . Map.toList . BiMultimap.range where diff --git a/unison-core/src/Unison/Var.hs b/unison-core/src/Unison/Var.hs index a78b6638e2..981378624a 100644 --- a/unison-core/src/Unison/Var.hs +++ b/unison-core/src/Unison/Var.hs @@ -58,7 +58,7 @@ named n = typed (User n) -- This bakes the fresh id into the name portion of the variable -- and resets the id to 0. -bakeId :: Var v => v -> v +bakeId :: (Var v) => v -> v bakeId v = named (name v) rawName :: Type -> Text diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index f5ea030c43..51f20e271a 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -34,7 +34,7 @@ library Unison.DataDeclaration.Records Unison.Hashable Unison.HashQualified - Unison.HashQualified' + Unison.HashQualifiedPrime Unison.Kind Unison.LabeledDependency Unison.Name @@ -48,19 +48,21 @@ library Unison.Project Unison.Reference Unison.Referent - Unison.Referent' + Unison.ReferentPrime Unison.Settings Unison.Symbol Unison.Term Unison.Type Unison.Type.Names Unison.Util.Components + Unison.Util.Defns + Unison.Util.Nametree Unison.Var Unison.WatchKind hs-source-dirs: src default-extensions: - ApplicativeDo + BangPatterns BlockArguments DeriveAnyClass DeriveFoldable @@ -68,17 +70,21 @@ library DeriveGeneric DeriveTraversable DerivingStrategies + DerivingVia DoAndIfThenElse + DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving ImportQualifiedPost + InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings + OverloadedRecordDot PatternSynonyms RankNTypes ScopedTypeVariables @@ -102,6 +108,8 @@ library , nonempty-containers , rfc5051 , safe + , semialign + , semigroups , text , text-builder , these @@ -123,7 +131,7 @@ test-suite tests hs-source-dirs: test default-extensions: - ApplicativeDo + BangPatterns BlockArguments DeriveAnyClass DeriveFoldable @@ -131,17 +139,21 @@ test-suite tests DeriveGeneric DeriveTraversable DerivingStrategies + DerivingVia DoAndIfThenElse + DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving ImportQualifiedPost + InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings + OverloadedRecordDot PatternSynonyms RankNTypes ScopedTypeVariables diff --git a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs index 25a042e50c..14a5e0e809 100644 --- a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs +++ b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs @@ -103,15 +103,15 @@ charRef = ReferenceBuiltin "Char" listRef = ReferenceBuiltin "Sequence" effectRef = ReferenceBuiltin "Effect" -forall :: (Ord v) => a -> v -> Type v a -> Type v a -forall a v body = ABT.tm' a (TypeForall (ABT.abs' a v body)) +forAll :: (Ord v) => a -> v -> Type v a -> Type v a +forAll a v body = ABT.tm' a (TypeForall (ABT.abs' a v body)) -- | Bind the given variables with an outer `forall`, if they are used in `t`. generalize :: (Ord v) => [v] -> Type v a -> Type v a generalize vs t = foldr f t vs where f v t = - if Set.member v (ABT.freeVars t) then forall (ABT.annotation t) v t else t + if Set.member v (ABT.freeVars t) then forAll (ABT.annotation t) v t else t unforall' :: Type v a -> ([v], Type v a) unforall' (ForallsNamed' vs t) = (vs, t) diff --git a/unison-merge/package.yaml b/unison-merge/package.yaml index 73f33af4a5..c31adfcd5b 100644 --- a/unison-merge/package.yaml +++ b/unison-merge/package.yaml @@ -34,9 +34,9 @@ dependencies: - unison-sqlite - unison-syntax - unison-util-cache - - unison-util-nametree - unison-util-relation - vector + - witch - witherable library: diff --git a/unison-merge/src/Unison/Merge/CombineDiffs.hs b/unison-merge/src/Unison/Merge/CombineDiffs.hs index c983eba79f..973a6911a8 100644 --- a/unison-merge/src/Unison/Merge/CombineDiffs.hs +++ b/unison-merge/src/Unison/Merge/CombineDiffs.hs @@ -44,7 +44,7 @@ combine :: These (DiffOp (Synhashed a)) (DiffOp (Synhashed a)) -> CombinedDiffOp combine = TwoDiffOps.make >>> combine1 >>> fmap (view #value) -combine1 :: Eq a => TwoDiffOps a -> CombinedDiffOp a +combine1 :: (Eq a) => TwoDiffOps a -> CombinedDiffOp a combine1 = \case TwoDiffOps'Add x -> CombinedDiffOp'Add (xor2ior x) TwoDiffOps'Delete x -> CombinedDiffOp'Delete (xor2ior x) diff --git a/unison-merge/src/Unison/Merge/Database.hs b/unison-merge/src/Unison/Merge/Database.hs index 28cc05c937..47d40954e6 100644 --- a/unison-merge/src/Unison/Merge/Database.hs +++ b/unison-merge/src/Unison/Merge/Database.hs @@ -47,7 +47,7 @@ data MergeDatabase = MergeDatabase loadV1TermComponent :: Hash -> Transaction [(V1.Term V1.Symbol V1.Ann, V1.Type V1.Symbol V1.Ann)] } -makeMergeDatabase :: MonadIO m => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase +makeMergeDatabase :: (MonadIO m) => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase makeMergeDatabase codebase = liftIO do -- Create a bunch of cached database lookup functions loadCausal <- do diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 2a75252fcd..34e3139f4d 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -83,15 +83,17 @@ module Unison.Merge.DeclCoherencyCheck ( IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency, + + -- * Getting all failures rather than just the first + IncoherentDeclReasons (..), + checkAllDeclCoherency, ) where import Control.Lens ((%=), (.=), _2) -import Control.Monad.Except (ExceptT) import Control.Monad.Except qualified as Except import Control.Monad.State.Strict (StateT) import Control.Monad.State.Strict qualified as State -import Control.Monad.Trans.Except qualified as Except (except) import Data.Functor.Compose (Compose (..)) import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap @@ -132,91 +134,194 @@ data IncoherentDeclReason checkDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReason DeclNameLookup) -checkDeclCoherency loadDeclNumConstructors = +checkDeclCoherency loadDeclNumConstructors nametree = Except.runExceptT - . fmap (view #declNameLookup) + ( checkDeclCoherencyWith + (lift . loadDeclNumConstructors) + OnIncoherentDeclReasons + { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), -- :: Name -> Name -> Name -> m (), + onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), -- :: Name -> m (), + onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), -- :: Name -> Name -> m (), + onStrayConstructor = \x -> Except.throwError (IncoherentDeclReason'StrayConstructor x) -- :: Name -> m () + } + nametree + ) + +data IncoherentDeclReasons = IncoherentDeclReasons + { constructorAliases :: ![(Name, Name, Name)], + missingConstructorNames :: ![Name], + nestedDeclAliases :: ![(Name, Name)], + strayConstructors :: ![Name] + } + deriving stock (Eq, Generic) + +-- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first. +checkAllDeclCoherency :: + forall m. + (Monad m) => + (TypeReferenceId -> m Int) -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + m (Either IncoherentDeclReasons DeclNameLookup) +checkAllDeclCoherency loadDeclNumConstructors nametree = do + State.runStateT doCheck emptyReasons <&> \(declNameLookup, reasons) -> + if reasons == emptyReasons + then Right declNameLookup + else Left (reverseReasons reasons) + where + doCheck :: StateT IncoherentDeclReasons m DeclNameLookup + doCheck = + checkDeclCoherencyWith + (lift . loadDeclNumConstructors) + ( OnIncoherentDeclReasons + { onConstructorAlias = \x y z -> #constructorAliases %= ((x, y, z) :), + onMissingConstructorName = \x -> #missingConstructorNames %= (x :), + onNestedDeclAlias = \x y -> #nestedDeclAliases %= ((x, y) :), + onStrayConstructor = \x -> #strayConstructors %= (x :) + } + ) + nametree + + emptyReasons :: IncoherentDeclReasons + emptyReasons = + IncoherentDeclReasons [] [] [] [] + + reverseReasons :: IncoherentDeclReasons -> IncoherentDeclReasons + reverseReasons reasons = + IncoherentDeclReasons + { constructorAliases = reverse reasons.constructorAliases, + missingConstructorNames = reverse reasons.missingConstructorNames, + nestedDeclAliases = reverse reasons.nestedDeclAliases, + strayConstructors = reverse reasons.strayConstructors + } + +data OnIncoherentDeclReasons m = OnIncoherentDeclReasons + { onConstructorAlias :: Name -> Name -> Name -> m (), + onMissingConstructorName :: Name -> m (), + onNestedDeclAlias :: Name -> Name -> m (), + onStrayConstructor :: Name -> m () + } + +checkDeclCoherencyWith :: + forall m. + (Monad m) => + (TypeReferenceId -> m Int) -> + OnIncoherentDeclReasons m -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + m DeclNameLookup +checkDeclCoherencyWith loadDeclNumConstructors callbacks = + fmap (view #declNameLookup) . (`State.execStateT` DeclCoherencyCheckState Map.empty (DeclNameLookup Map.empty Map.empty)) . go [] where go :: [NameSegment] -> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> - StateT DeclCoherencyCheckState (ExceptT IncoherentDeclReason m) () + StateT DeclCoherencyCheckState m () go prefix (Nametree defns children) = do - for_ (Map.toList defns.terms) \case - (_, Referent.Ref _) -> pure () - (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () - (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do - DeclCoherencyCheckState {expectedConstructors} <- State.get - expectedConstructors1 <- lift (Except.except (Map.upsertF f typeRef expectedConstructors)) - #expectedConstructors .= expectedConstructors1 - where - f :: - Maybe (Name, ConstructorNames) -> - Either IncoherentDeclReason (Name, ConstructorNames) - f = \case - Nothing -> Left (IncoherentDeclReason'StrayConstructor name1) - Just (typeName, expected) -> - case recordConstructorName conId name1 expected of - Left existingName -> Left (IncoherentDeclReason'ConstructorAlias typeName existingName name1) - Right expected1 -> Right (typeName, expected1) - where - name1 = fullName name - + for_ (Map.toList defns.terms) (checkDeclCoherencyWith_DoTerms callbacks prefix) childrenWeWentInto <- - forMaybe (Map.toList defns.types) \case - (_, ReferenceBuiltin _) -> pure Nothing - (name, ReferenceDerived typeRef) -> do - DeclCoherencyCheckState {expectedConstructors} <- State.get - whatHappened <- do - let recordNewDecl :: - Maybe (Name, ConstructorNames) -> - Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, ConstructorNames) - recordNewDecl = - Compose . \case - Just (shorterTypeName, _) -> Except.throwError (IncoherentDeclReason'NestedDeclAlias shorterTypeName typeName) - Nothing -> - lift (loadDeclNumConstructors typeRef) <&> \case - 0 -> UninhabitedDecl - n -> InhabitedDecl (typeName, emptyConstructorNames n) - lift (getCompose (Map.upsertF recordNewDecl typeRef expectedConstructors)) - case whatHappened of - UninhabitedDecl -> do - #declNameLookup . #declToConstructors %= Map.insert typeName [] - pure Nothing - InhabitedDecl expectedConstructors1 -> do - child <- - Map.lookup name children & onNothing do - Except.throwError (IncoherentDeclReason'MissingConstructorName typeName) - #expectedConstructors .= expectedConstructors1 - go (name : prefix) child - DeclCoherencyCheckState {expectedConstructors} <- State.get - -- fromJust is safe here because we upserted `typeRef` key above - let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) = - Map.deleteLookup typeRef expectedConstructors - constructorNames <- - sequence (IntMap.elems maybeConstructorNames) & onNothing do - Except.throwError (IncoherentDeclReason'MissingConstructorName typeName) - #expectedConstructors .= expectedConstructors1 + forMaybe + (Map.toList defns.types) + (checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children) + let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto + for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child + +checkDeclCoherencyWith_DoTerms :: + forall m. + (Monad m) => + OnIncoherentDeclReasons m -> + [NameSegment] -> + (NameSegment, Referent) -> + StateT DeclCoherencyCheckState m () +checkDeclCoherencyWith_DoTerms callbacks prefix = \case + (_, Referent.Ref _) -> pure () + (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () + (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do + state <- State.get + whenJustM (lift (runMaybeT (Map.upsertF f typeRef state.expectedConstructors))) \expectedConstructors1 -> + #expectedConstructors .= expectedConstructors1 + where + f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames) + f = \case + Nothing -> do + lift (callbacks.onStrayConstructor name1) + MaybeT (pure Nothing) + Just (typeName, expected) -> + case recordConstructorName conId name1 expected of + Left existingName -> do + lift (callbacks.onConstructorAlias typeName existingName name1) + MaybeT (pure Nothing) + Right expected1 -> pure (typeName, expected1) + where + name1 = + Name.fromReverseSegments (name :| prefix) + +checkDeclCoherencyWith_DoTypes :: + forall m. + (Monad m) => + (TypeReferenceId -> m Int) -> + OnIncoherentDeclReasons m -> + ( [NameSegment] -> + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + StateT DeclCoherencyCheckState m () + ) -> + [NameSegment] -> + Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + (NameSegment, TypeReference) -> + StateT DeclCoherencyCheckState m (Maybe NameSegment) +checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children = \case + (_, ReferenceBuiltin _) -> pure Nothing + (name, ReferenceDerived typeRef) -> do + state <- State.get + maybeWhatHappened <- do + let recordNewDecl :: + Maybe (Name, ConstructorNames) -> + Compose (MaybeT m) WhatHappened (Name, ConstructorNames) + recordNewDecl = + Compose . \case + Just (shorterTypeName, _) -> do + lift (callbacks.onNestedDeclAlias shorterTypeName typeName) + MaybeT (pure Nothing) + Nothing -> + lift (loadDeclNumConstructors typeRef) <&> \case + 0 -> UninhabitedDecl + n -> InhabitedDecl (typeName, emptyConstructorNames n) + lift (runMaybeT (getCompose (Map.upsertF recordNewDecl typeRef state.expectedConstructors))) + case maybeWhatHappened of + Nothing -> pure Nothing + Just UninhabitedDecl -> do + #declNameLookup . #declToConstructors %= Map.insert typeName [] + pure Nothing + Just (InhabitedDecl expectedConstructors1) -> do + case Map.lookup name children of + Nothing -> do + lift (callbacks.onMissingConstructorName typeName) + pure Nothing + Just child -> do + #expectedConstructors .= expectedConstructors1 + go (name : prefix) child + state <- State.get + -- fromJust is safe here because we upserted `typeRef` key above + let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) = + Map.deleteLookup typeRef state.expectedConstructors + #expectedConstructors .= expectedConstructors1 + case sequence (IntMap.elems maybeConstructorNames) of + Nothing -> lift (callbacks.onMissingConstructorName typeName) + Just constructorNames -> do #declNameLookup . #constructorToDecl %= \constructorToDecl -> List.foldl' (\acc constructorName -> Map.insert constructorName typeName acc) constructorToDecl constructorNames #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames - pure (Just name) - where - typeName = fullName name - - let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto - for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child - where - fullName name = - Name.fromReverseSegments (name :| prefix) + pure (Just name) + where + typeName = + Name.fromReverseSegments (name :| prefix) -- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, -- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. @@ -226,7 +331,7 @@ checkDeclCoherency loadDeclNumConstructors = -- does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m PartialDeclNameLookup @@ -327,7 +432,7 @@ emptyConstructorNames :: Int -> ConstructorNames emptyConstructorNames numConstructors = IntMap.fromAscList [(i, Nothing) | i <- [0 .. numConstructors - 1]] -recordConstructorName :: HasCallStack => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames +recordConstructorName :: (HasCallStack) => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames recordConstructorName conId conName = IntMap.alterF f (fromIntegral @Word64 @Int conId) where diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-merge/src/Unison/Merge/DeclNameLookup.hs index 08611a944c..35e5b5e10f 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-merge/src/Unison/Merge/DeclNameLookup.hs @@ -40,13 +40,13 @@ data DeclNameLookup = DeclNameLookup deriving stock (Generic) deriving (Semigroup) via (GenericSemigroupMonoid DeclNameLookup) -expectDeclName :: HasCallStack => DeclNameLookup -> Name -> Name +expectDeclName :: (HasCallStack) => DeclNameLookup -> Name -> Name expectDeclName DeclNameLookup {constructorToDecl} x = case Map.lookup x constructorToDecl of Nothing -> error (reportBug "E246726" ("Expected constructor name key " <> show x <> " in decl name lookup")) Just y -> y -expectConstructorNames :: HasCallStack => DeclNameLookup -> Name -> [Name] +expectConstructorNames :: (HasCallStack) => DeclNameLookup -> Name -> [Name] expectConstructorNames DeclNameLookup {declToConstructors} x = case Map.lookup x declToConstructors of Nothing -> error (reportBug "E077058" ("Expected decl name key " <> show x <> " in decl name lookup")) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 1ad67238a4..ca57953a2c 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -13,7 +13,7 @@ import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Hash (Hash (Hash)) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Merge.Database (MergeDatabase (..)) import Unison.Merge.DeclNameLookup (DeclNameLookup) import Unison.Merge.DeclNameLookup qualified as DeclNameLookup @@ -143,7 +143,7 @@ diffNamespaceDefns = f old new = Map.mapMaybe id (alignWith g old new) - g :: Eq x => These x x -> Maybe (DiffOp x) + g :: (Eq x) => These x x -> Maybe (DiffOp x) g = \case This old -> Just (DiffOp'Delete old) That new -> Just (DiffOp'Add new) @@ -158,7 +158,7 @@ deepNamespaceDefinitionsToPpe :: Defns (BiMultimap Referent Name) (BiMultimap Ty deepNamespaceDefinitionsToPpe Defns {terms, types} = PrettyPrintEnv (arbitraryName terms) (arbitraryName types) where - arbitraryName :: Ord ref => BiMultimap ref Name -> ref -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] + arbitraryName :: (Ord ref) => BiMultimap ref Name -> ref -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] arbitraryName names ref = BiMultimap.lookupDom ref names & Set.lookupMin @@ -168,7 +168,7 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = -- Syntactic hashing helpers synhashDefnsWith :: - Monad m => + (Monad m) => (Name -> term -> m Hash) -> (Name -> typ -> m Hash) -> Defns (BiMultimap term Name) (BiMultimap typ Name) -> diff --git a/unison-merge/src/Unison/Merge/Libdeps.hs b/unison-merge/src/Unison/Merge/Libdeps.hs index 61b5754417..defacf036b 100644 --- a/unison-merge/src/Unison/Merge/Libdeps.hs +++ b/unison-merge/src/Unison/Merge/Libdeps.hs @@ -72,11 +72,11 @@ mergeDiffs :: mergeDiffs alice bob = catMaybes (alignWith combineDiffOps alice bob) -combineDiffOps :: Eq a => These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a) +combineDiffOps :: (Eq a) => These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a) combineDiffOps = TwoDiffOps.make >>> combineDiffOps1 -combineDiffOps1 :: Eq a => TwoDiffOps a -> Maybe (LibdepDiffOp a) +combineDiffOps1 :: (Eq a) => TwoDiffOps a -> Maybe (LibdepDiffOp a) combineDiffOps1 = \case TwoDiffOps'Add new -> Just (AddLibdep (EitherWay.value new)) -- If Alice deletes a dep and Bob doesn't touch it, ignore the delete, since Bob may still be using it. diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 05787791f5..5b63f0323e 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -64,7 +64,7 @@ makeInitialIdentifyConflictsState diff = } identifyConflicts :: - HasCallStack => + (HasCallStack) => TwoWay DeclNameLookup -> TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index 6acf835a75..ec28369bfc 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -30,10 +30,15 @@ module Unison.Merge.Synhash synhashTerm, synhashBuiltinDecl, synhashDerivedDecl, + + -- * Exported for debugging + hashBuiltinTermTokens, + hashDerivedTermTokens, ) where import Data.Char (ord) +import Data.List qualified as List import Data.Text qualified as Text import U.Codebase.Reference (TypeReference) import Unison.ABT qualified as ABT @@ -61,7 +66,7 @@ import Unison.Term qualified as Term import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Var (Var) -import Unison.Var qualified as Var +import Witch (unsafeFrom) type Token = H.Token Hash @@ -80,8 +85,12 @@ synhashBuiltinDecl name = H.accumulate [isBuiltinTag, isDeclTag, H.Text name] hashBuiltinTerm :: Text -> Hash -hashBuiltinTerm name = - H.accumulate [isBuiltinTag, isTermTag, H.Text name] +hashBuiltinTerm = + H.accumulate . hashBuiltinTermTokens + +hashBuiltinTermTokens :: Text -> [Token] +hashBuiltinTermTokens name = + [isBuiltinTag, isTermTag, H.Text name] hashCaseTokens :: PrettyPrintEnv -> Term.MatchCase loc a -> [Token] hashCaseTokens ppe (Term.MatchCase pat Nothing _) = H.Tag 0 : hashPatternTokens ppe pat @@ -107,30 +116,40 @@ hashConstructorNameToken declName conName = ) in H.Text (Name.toText strippedConName) -hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash -hashDerivedTerm ppe t = - H.accumulate $ isNotBuiltinTag : isTermTag : hashTermTokens ppe t +hashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash +hashDerivedTerm ppe term = + H.accumulate (hashDerivedTermTokens ppe term) + +hashDerivedTermTokens :: forall a v. (Var v) => PrettyPrintEnv -> Term v a -> [Token] +hashDerivedTermTokens ppe = + (isNotBuiltinTag :) . (isTermTag :) . go [] + where + go :: [v] -> Term v a -> [Token] + go bound t = + H.Tag 255 : case ABT.out t of + ABT.Var v -> [H.Tag 0, hashVarToken bound v] + -- trick: encode the structure, followed the children as a flat list + ABT.Tm f -> H.Tag 1 : hashTermFTokens ppe (void f) <> (toList f >>= go bound) + ABT.Cycle c -> H.Tag 2 : go bound c + ABT.Abs v body -> H.Tag 3 : go (v : bound) body hashConstructorType :: ConstructorType -> Token hashConstructorType = \case CT.Effect -> H.Tag 0 CT.Data -> H.Tag 1 -hashDataDeclTokens :: Var v => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token] -hashDataDeclTokens ppe declName (DD.DataDeclaration modifier _ vs ctors) = - hashModifierTokens modifier <> goVs <> (ctors >>= hashConstructorTokens ppe declName) - where - goVs = - hashLengthToken vs : map hashVarToken vs +hashDataDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token] +hashDataDeclTokens ppe declName (DD.DataDeclaration modifier _ bound ctors) = + hashModifierTokens modifier <> (ctors >>= hashConstructorTokens ppe declName bound) -- separating constructor types with tag of 99, which isn't used elsewhere -hashConstructorTokens :: Var v => PrettyPrintEnv -> Name -> (a, v, Type v a) -> [Token] -hashConstructorTokens ppe declName (_, conName, ty) = +hashConstructorTokens :: (Var v) => PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token] +hashConstructorTokens ppe declName bound (_, conName, ty) = H.Tag 99 : hashConstructorNameToken declName (Name.unsafeParseVar conName) - : hashTypeTokens ppe ty + : hashTypeTokens ppe bound ty -hashDeclTokens :: Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token] +hashDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> [Token] hashDeclTokens ppe name decl = hashConstructorType (DD.constructorType decl) : hashDataDeclTokens ppe name (DD.asDataDecl decl) @@ -138,7 +157,7 @@ hashDeclTokens ppe name decl = -- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same, -- the constructors appear in the same order and have the same names, and the constructors' types have the same -- syntactic hashes. -synhashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash +synhashDerivedDecl :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> Hash synhashDerivedDecl ppe name decl = H.accumulate $ isNotBuiltinTag : isDeclTag : hashDeclTokens ppe name decl @@ -151,7 +170,7 @@ hashKindTokens k = case k of K.Star -> [H.Tag 0] K.Arrow k1 k2 -> H.Tag 1 : (hashKindTokens k1 <> hashKindTokens k2) -hashLengthToken :: Foldable t => t a -> Token +hashLengthToken :: (Foldable t) => t a -> Token hashLengthToken = H.Nat . fromIntegral @Int @Word64 . length @@ -205,20 +224,7 @@ synhashTerm loadTerm ppe = \case ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref -hashTermTokens :: forall v a. Var v => PrettyPrintEnv -> Term v a -> [Token] -hashTermTokens ppe = - go - where - go :: Term v a -> [Token] - go t = - H.Tag 255 : case ABT.out t of - ABT.Var v -> [H.Tag 0, hashVarToken v] - -- trick: encode the structure, followed the children as a flat list - ABT.Tm f -> H.Tag 1 : hashTermFTokens ppe (void f) <> (toList f >>= go) - ABT.Cycle c -> H.Tag 2 : go c - ABT.Abs v body -> H.Tag 3 : hashVarToken v : go body - -hashTermFTokens :: Var v => PrettyPrintEnv -> Term.F v a a () -> [Token] +hashTermFTokens :: (Var v) => PrettyPrintEnv -> Term.F v a a () -> [Token] hashTermFTokens ppe = \case Term.Int n -> [H.Tag 0, H.Int n] Term.Nat n -> [H.Tag 1, H.Nat n] @@ -233,7 +239,7 @@ hashTermFTokens ppe = \case Term.Request cr -> [H.Tag 7, hashReferentToken ppe (Referent.Con cr CT.Effect)] Term.Handle {} -> [H.Tag 8] Term.App {} -> [H.Tag 9] - Term.Ann _ ty -> H.Tag 10 : hashTypeTokens ppe ty + Term.Ann _ ty -> H.Tag 10 : hashTypeTokens ppe [] ty Term.List xs -> [H.Tag 11, hashLengthToken xs] Term.If {} -> [H.Tag 12] Term.And {} -> [H.Tag 13] @@ -249,21 +255,21 @@ hashTermFTokens ppe = \case -- | Syntactically hash a type, using reference names rather than hashes. -- Two types will have the same syntactic hash if they would -- print the the same way under the given pretty-print env. -synhashType :: Var v => PrettyPrintEnv -> Type v a -> Hash -synhashType ppe t = - H.accumulate $ hashTypeTokens ppe t +synhashType :: (Var v) => PrettyPrintEnv -> Type v a -> Hash +synhashType ppe ty = + H.accumulate $ hashTypeTokens ppe [] ty -hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> Type v a -> [Token] +hashTypeTokens :: forall v a. (Var v) => PrettyPrintEnv -> [v] -> Type v a -> [Token] hashTypeTokens ppe = go where - go :: Type v a -> [Token] - go t = + go :: [v] -> Type v a -> [Token] + go bound t = H.Tag 254 : case ABT.out t of - ABT.Var v -> [H.Tag 0, hashVarToken v] + ABT.Var v -> [H.Tag 0, hashVarToken bound v] -- trick: encode the structure, followed the children as a flat list - ABT.Tm f -> H.Tag 1 : (hashTypeFTokens ppe (void f) <> (toList f >>= go)) - ABT.Cycle c -> H.Tag 2 : go c - ABT.Abs v body -> H.Tag 3 : hashVarToken v : go body + ABT.Tm f -> H.Tag 1 : (hashTypeFTokens ppe (void f) <> (toList f >>= go bound)) + ABT.Cycle c -> H.Tag 2 : go bound c + ABT.Abs v body -> H.Tag 3 : go (v : bound) body hashTypeFTokens :: PrettyPrintEnv -> Type.F () -> [Token] hashTypeFTokens ppe = \case @@ -280,6 +286,8 @@ hashTypeReferenceToken :: PrettyPrintEnv -> TypeReference -> Token hashTypeReferenceToken ppe = hashHQNameToken . PPE.typeNameOrHashOnlyFq ppe -hashVarToken :: Var v => v -> Token -hashVarToken = - H.Text . Var.name +hashVarToken :: (Var v) => [v] -> v -> Token +hashVarToken bound v = + case List.elemIndex v bound of + Nothing -> error (reportBug "E633940" ("var " ++ show v ++ " not bound in " ++ show bound)) + Just index -> H.Nat (unsafeFrom @Int @Word64 index) diff --git a/unison-merge/src/Unison/Merge/TwoWay.hs b/unison-merge/src/Unison/Merge/TwoWay.hs index 05640a3786..bad9a928f9 100644 --- a/unison-merge/src/Unison/Merge/TwoWay.hs +++ b/unison-merge/src/Unison/Merge/TwoWay.hs @@ -80,7 +80,7 @@ twoWay f TwoWay {alice, bob} = f alice bob -- | Unzip a @Map k (TwoWay v)@ into a @TwoWay (Map k v)@. -unzipMap :: Ord k => Map k (TwoWay v) -> TwoWay (Map k v) +unzipMap :: (Ord k) => Map k (TwoWay v) -> TwoWay (Map k v) unzipMap = fromPair . unzipWith (\TwoWay {alice, bob} -> (alice, bob)) diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index ab6bebe3db..83131b33be 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -103,9 +103,9 @@ library , unison-sqlite , unison-syntax , unison-util-cache - , unison-util-nametree , unison-util-relation , vector + , witch , witherable default-language: Haskell2010 if !os(windows) diff --git a/unison-share-api/package.yaml b/unison-share-api/package.yaml index 6bea13f3dc..132a623041 100644 --- a/unison-share-api/package.yaml +++ b/unison-share-api/package.yaml @@ -9,7 +9,6 @@ library: other-modules: Paths_unison_share_api dependencies: - - NanoID - aeson >= 2.0.0.0 - async - base @@ -17,6 +16,7 @@ dependencies: - bytes - bytestring - containers + - cryptonite - Diff - directory - errors diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index c2e2ceffb0..6bea3c704a 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -38,7 +38,7 @@ module Unison.Server.Backend lsAtPath, lsBranch, mungeSyntaxText, - resolveCausalHashV2, + Codebase.expectCausalBranchByCausalHash, resolveRootBranchHashV2, namesAtPathFromRootBranchHash, termEntryDisplayName, @@ -58,7 +58,6 @@ module Unison.Server.Backend renderDocRefs, docsForDefinitionName, normaliseRootCausalHash, - causalHashForProjectBranchName, -- * Unused, could remove? resolveRootBranchHash, @@ -101,16 +100,12 @@ import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (BranchHash, CausalHash (..)) import U.Codebase.Referent qualified as V2Referent -import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Operations qualified as Ops -import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) -import U.Codebase.Sqlite.Queries qualified as Q import Unison.ABT qualified as ABT import Unison.Builtin qualified as B import Unison.Builtin.Decls qualified as Decls import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase qualified as UCodebase import Unison.Codebase.Branch (Branch) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch @@ -130,7 +125,7 @@ import Unison.ConstructorType qualified as CT import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.Dependencies qualified as DD import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashing.V2.Convert qualified as Hashing import Unison.LabeledDependency qualified as LD import Unison.Name (Name) @@ -148,8 +143,7 @@ import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnv.Util qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED -import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) -import Unison.Project.Util qualified as ProjectUtils +import Unison.Project (ProjectBranchName, ProjectName) import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -161,7 +155,7 @@ import Unison.Server.NameSearch (NameSearch (..), Search (..), applySearch) import Unison.Server.NameSearch.Sqlite (termReferentsByShortHash, typeReferencesByShortHash) import Unison.Server.QueryResult import Unison.Server.SearchResult qualified as SR -import Unison.Server.SearchResult' qualified as SR' +import Unison.Server.SearchResultPrime qualified as SR' import Unison.Server.Syntax qualified as Syntax import Unison.Server.Types import Unison.Server.Types qualified as ServerTypes @@ -170,7 +164,7 @@ import Unison.ShortHash qualified as SH import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.DeclPrinter qualified as DeclPrinter -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Name as Name (toText, unsafeParseText) import Unison.Syntax.NamePrinter qualified as NP import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) @@ -219,10 +213,10 @@ data BackendError = NoSuchNamespace Path.Absolute | -- Failed to parse path BadNamespace + -- | error message String - -- ^ error message + -- | namespace String - -- ^ namespace | CouldntExpandBranchHash ShortCausalHash | AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash) | AmbiguousHashForDefinition ShortHash @@ -370,12 +364,12 @@ lsAtPath :: (MonadIO m) => Codebase m Symbol Ann -> -- The root to follow the path from. - Maybe (V2Branch.Branch Sqlite.Transaction) -> + V2Branch.Branch Sqlite.Transaction -> -- Path from the root to the branch to 'ls' Path.Absolute -> m [ShallowListEntry Symbol Ann] -lsAtPath codebase mayRootBranch absPath = do - b <- Codebase.runTransaction codebase (Codebase.getShallowBranchAtPath (Path.unabsolute absPath) mayRootBranch) +lsAtPath codebase rootBranch absPath = do + b <- Codebase.runTransaction codebase (Codebase.getShallowBranchAtPath (Path.unabsolute absPath) rootBranch) lsBranch codebase b findDocInBranch :: @@ -468,11 +462,11 @@ getTermTag codebase r sig = do V2Referent.Con ref _ -> Just <$> Codebase.runTransaction codebase (Codebase.getDeclType codebase ref) pure $ if - | isDoc -> Doc - | isTest -> Test - | Just CT.Effect <- constructorType -> Constructor Ability - | Just CT.Data <- constructorType -> Constructor Data - | otherwise -> Plain + | isDoc -> Doc + | isTest -> Test + | Just CT.Effect <- constructorType -> Constructor Ability + | Just CT.Data <- constructorType -> Constructor Data + | otherwise -> Plain getTypeTag :: (Var v) => @@ -579,14 +573,10 @@ lsBranch codebase b0 = do (ns, (h, stats)) <- Map.toList $ childrenWithStats guard $ V2Branch.hasDefinitions stats pure $ ShallowBranchEntry ns (V2Causal.causalHash h) stats - patchEntries :: [ShallowListEntry Symbol Ann] = do - (ns, _h) <- Map.toList $ V2Branch.patches b0 - pure $ ShallowPatchEntry ns pure . List.sortOn listEntryName $ termEntries ++ typeEntries ++ branchEntries - ++ patchEntries -- Any absolute names in the input which have `root` as a prefix -- are converted to names relative to current path. All other names are @@ -704,14 +694,12 @@ expandShortCausalHash hash = do -- | Efficiently resolve a root hash and path to a shallow branch's causal. getShallowCausalAtPathFromRootHash :: - Maybe CausalHash -> + CausalHash -> Path -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -getShallowCausalAtPathFromRootHash mayRootHash path = do - shallowRoot <- case mayRootHash of - Nothing -> Codebase.getShallowRootCausal - Just h -> Codebase.expectCausalBranchByCausalHash h - Codebase.getShallowCausalAtPath path (Just shallowRoot) +getShallowCausalAtPathFromRootHash rootHash path = do + shallowRoot <- Codebase.expectCausalBranchByCausalHash rootHash + Codebase.getShallowCausalAtPath path shallowRoot formatType' :: (Var v) => PPE.PrettyPrintEnv -> Width -> Type v a -> SyntaxText formatType' ppe w = @@ -991,16 +979,12 @@ namesAtPathFromRootBranchHash :: forall m n v a. (MonadIO m) => Codebase m v a -> - Maybe (V2Branch.CausalBranch n) -> + V2Branch.CausalBranch n -> Path -> Backend m (Names, PPED.PrettyPrintEnvDecl) -namesAtPathFromRootBranchHash codebase mbh path = do +namesAtPathFromRootBranchHash codebase cb path = do shouldUseNamesIndex <- asks useNamesIndex - (rootBranchHash, rootCausalHash) <- case mbh of - Just cb -> pure (V2Causal.valueHash cb, V2Causal.causalHash cb) - Nothing -> lift $ do - cb <- Codebase.runTransaction codebase Operations.expectRootCausal - pure (V2Causal.valueHash cb, V2Causal.causalHash cb) + let (rootBranchHash, rootCausalHash) = (V2Causal.valueHash cb, V2Causal.causalHash cb) haveNameLookupForRoot <- lift $ Codebase.runTransaction codebase (Ops.checkBranchHashNameLookupExists rootBranchHash) hashLen <- lift $ Codebase.runTransaction codebase Codebase.hashLength names <- @@ -1009,47 +993,34 @@ namesAtPathFromRootBranchHash codebase mbh path = do when (not haveNameLookupForRoot) . throwError $ ExpectedNameLookup rootBranchHash lift . Codebase.runTransaction codebase $ Codebase.namesAtPath rootBranchHash path else do - Branch.toNames . Branch.getAt0 path . Branch.head <$> resolveCausalHash (Just rootCausalHash) codebase + Branch.toNames . Branch.getAt0 path . Branch.head <$> resolveCausalHash rootCausalHash codebase let pped = PPED.makePPED (PPE.hqNamer hashLen names) (PPE.suffixifyByHash names) pure (names, pped) resolveCausalHash :: - (Monad m) => Maybe CausalHash -> Codebase m v a -> Backend m (Branch m) -resolveCausalHash h codebase = case h of - Nothing -> lift (Codebase.getRootBranch codebase) - Just bhash -> do - mayBranch <- lift $ Codebase.getBranchForHash codebase bhash - whenNothing mayBranch (throwError $ NoBranchForHash bhash) - -resolveCausalHashV2 :: Maybe CausalHash -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -resolveCausalHashV2 h = case h of - Nothing -> Codebase.getShallowRootCausal - Just ch -> Codebase.expectCausalBranchByCausalHash ch + (Monad m) => CausalHash -> Codebase m v a -> Backend m (Branch m) +resolveCausalHash bhash codebase = do + mayBranch <- lift $ Codebase.getBranchForHash codebase bhash + whenNothing mayBranch (throwError $ NoBranchForHash bhash) resolveRootBranchHash :: - (MonadIO m) => Maybe ShortCausalHash -> Codebase m v a -> Backend m (Branch m) -resolveRootBranchHash mayRoot codebase = case mayRoot of - Nothing -> - lift (Codebase.getRootBranch codebase) - Just sch -> do - h <- hoistBackend (Codebase.runTransaction codebase) (expandShortCausalHash sch) - resolveCausalHash (Just h) codebase + (MonadIO m) => ShortCausalHash -> Codebase m v a -> Backend m (Branch m) +resolveRootBranchHash sch codebase = do + h <- hoistBackend (Codebase.runTransaction codebase) (expandShortCausalHash sch) + resolveCausalHash h codebase resolveRootBranchHashV2 :: - Maybe ShortCausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -resolveRootBranchHashV2 mayRoot = case mayRoot of - Nothing -> lift Codebase.getShallowRootCausal - Just sch -> do - h <- expandShortCausalHash sch - lift (resolveCausalHashV2 (Just h)) - -normaliseRootCausalHash :: Maybe (Either ShortCausalHash CausalHash) -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -normaliseRootCausalHash mayCh = case mayCh of - Nothing -> lift $ resolveCausalHashV2 Nothing - Just (Left sch) -> do + ShortCausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) +resolveRootBranchHashV2 sch = do + h <- expandShortCausalHash sch + lift (Codebase.expectCausalBranchByCausalHash h) + +normaliseRootCausalHash :: Either ShortCausalHash CausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) +normaliseRootCausalHash = \case + (Left sch) -> do ch <- expandShortCausalHash sch - lift $ resolveCausalHashV2 (Just ch) - Just (Right ch) -> lift $ resolveCausalHashV2 (Just ch) + lift $ Codebase.expectCausalBranchByCausalHash ch + (Right ch) -> lift $ Codebase.expectCausalBranchByCausalHash ch -- | Determines whether we include full cycles in the results, (e.g. if I search for `isEven`, will I find `isOdd` too?) -- @@ -1275,15 +1246,3 @@ loadTypeDisplayObject c = \case Reference.DerivedId id -> maybe (MissingObject $ Reference.idToShortHash id) UserObject <$> Codebase.getTypeDeclaration c id - --- | Get the causal hash a given project branch points to -causalHashForProjectBranchName :: (MonadIO m) => ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe CausalHash) -causalHashForProjectBranchName (ProjectAndBranch projectName branchName) = do - Q.loadProjectBranchByNames projectName branchName >>= \case - Nothing -> pure Nothing - Just ProjectBranch {projectId, branchId} -> do - let path = ProjectUtils.projectBranchPath (ProjectAndBranch projectId branchId) - -- Use the default codebase root - let codebaseRoot = Nothing - mayCausal <- UCodebase.getShallowCausalFromRoot codebaseRoot (Path.unabsolute path) - pure . Just $ V2Causal.causalHash mayCausal diff --git a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs index 443f064545..d69f0ac8a3 100644 --- a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs +++ b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs @@ -16,7 +16,7 @@ import Unison.Server.Types (DisplayObjectDiff (..), SemanticSyntaxDiff (..)) import Unison.Util.AnnotatedText (AnnotatedText (..)) import Unison.Util.AnnotatedText qualified as AT -diffDisplayObjects :: HasCallStack => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff +diffDisplayObjects :: (HasCallStack) => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff diffDisplayObjects from to = case (from, to) of (BuiltinObject fromST, BuiltinObject toST) -> DisplayObjectDiff (BuiltinObject (diffSyntaxText fromST toST)) (MissingObject fromSH, MissingObject toSH) diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index 7ceef3c0fe..1bbdfa5e24 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -10,13 +10,14 @@ import Control.Concurrent.Async (race) import Control.Exception (ErrorCall (..), throwIO) import Control.Monad.Reader import Control.Monad.Trans.Except +import Crypto.Random qualified as Crypto import Data.Aeson () +import Data.ByteArray.Encoding qualified as BE import Data.ByteString qualified as Strict import Data.ByteString.Char8 (unpack) import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy.UTF8 qualified as BLU -import Data.NanoID (customNanoID, defaultAlphabet, unNanoID) import Data.OpenApi (Info (..), License (..), OpenApi, URL (..)) import Data.OpenApi.Lens qualified as OpenApi import Data.Proxy (Proxy (..)) @@ -83,7 +84,8 @@ import System.Directory (canonicalizePath, doesFileExist) import System.Environment (getExecutablePath) import System.FilePath (()) import System.FilePath qualified as FilePath -import System.Random.MWC (createSystemRandom) +import U.Codebase.Branch qualified as V2 +import U.Codebase.Causal qualified as Causal import U.Codebase.HashTags (CausalHash) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -117,16 +119,13 @@ import Unison.Server.Local.Endpoints.Projects (ListProjectBranchesEndpoint, List import Unison.Server.Local.Endpoints.UCM (UCMAPI, ucmServer) import Unison.Server.NameSearch (NameSearch (..)) import Unison.Server.NameSearch.FromNames qualified as Names -import Unison.Server.Types (TermDefinition (..), TermDiffResponse (..), TypeDefinition (..), TypeDiffResponse (..), mungeString, setCacheControl) +import Unison.Server.Types (RequiredQueryParam, TermDefinition (..), TermDiffResponse (..), TypeDefinition (..), TypeDiffResponse (..), mungeString, setCacheControl) import Unison.ShortHash qualified as ShortHash import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Pretty qualified as Pretty --- | Fail the route with a reasonable error if the query param is missing. -type RequiredQueryParam = Servant.QueryParam' '[Servant.Required, Servant.Strict] - -- HTML content type data HTML = HTML @@ -142,11 +141,8 @@ type OpenApiJSON = "openapi.json" :> Get '[JSON] OpenApi type UnisonAndDocsAPI = UnisonLocalAPI :<|> OpenApiJSON :<|> Raw -type LooseCodeAPI = CodebaseServerAPI - type UnisonLocalAPI = ("projects" :> ProjectsAPI) - :<|> ("non-project-code" :> LooseCodeAPI) :<|> ("ucm" :> UCMAPI) type CodebaseServerAPI = @@ -234,9 +230,8 @@ data DefinitionReference deriving stock (Show) data Service - = LooseCodeUI Path.Absolute (Maybe DefinitionReference) - | -- (Project branch names, perspective within project, definition reference) - ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Path (Maybe DefinitionReference) + = -- (Project branch names, perspective within project, definition reference) + ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Absolute (Maybe DefinitionReference) | Api deriving stock (Show) @@ -295,14 +290,12 @@ data URISegment urlFor :: Service -> BaseUrl -> Text urlFor service baseUrl = case service of - LooseCodeUI perspective def -> - tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "non-project-code"] <> path (Path.unabsolute perspective) def) ProjectBranchUI (ProjectAndBranch projectName branchName) perspective def -> tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "projects", DontEscape $ into @Text projectName, DontEscape $ into @Text branchName] <> path perspective def) Api -> tShow baseUrl <> "/" <> toUrlPath [DontEscape "api"] where - path :: Path.Path -> Maybe DefinitionReference -> [URISegment] - path ns def = + path :: Path.Absolute -> Maybe DefinitionReference -> [URISegment] + path (Path.Absolute ns) def = let nsPath = namespacePath ns in case definitionPath def of Just defPath -> case nsPath of @@ -407,11 +400,18 @@ app env rt codebase uiPath expectedToken allowCorsHost = -- | The Token is used to help prevent multiple users on a machine gain access to -- each others codebases. +-- +-- Generate a cryptographically secure random token. +-- https://neilmadden.blog/2018/08/30/moving-away-from-uuids/ +-- +-- E.g. +-- >>> genToken +-- "uxf85C7Y0B6om47" genToken :: IO Strict.ByteString genToken = do - g <- createSystemRandom - n <- customNanoID defaultAlphabet 16 g - pure $ unNanoID n + BE.convertToBase @ByteString BE.Base64URLUnpadded <$> Crypto.getRandomBytes numRandomBytes + where + numRandomBytes = 10 data Waiter a = Waiter { notify :: a -> IO (), @@ -560,18 +560,6 @@ serveOpenAPI = pure openAPI hoistWithAuth :: forall api. (HasServer api '[]) => Proxy api -> ByteString -> ServerT api Handler -> ServerT (Authed api) Handler hoistWithAuth api expectedToken server token = hoistServer @api @Handler @Handler api (\h -> handleAuth expectedToken token *> h) server -serveLooseCode :: - Codebase IO Symbol Ann -> - Rt.Runtime Symbol -> - ServerT LooseCodeAPI (Backend IO) -serveLooseCode codebase rt = - (\root rel name -> setCacheControl <$> NamespaceListing.serve codebase (Left <$> root) rel name) - :<|> (\namespaceName mayRoot renderWidth -> setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Left <$> mayRoot) renderWidth) - :<|> (\mayRoot relativePath rawHqns renderWidth suff -> setCacheControl <$> serveDefinitions rt codebase (Left <$> mayRoot) relativePath rawHqns renderWidth suff) - :<|> (\mayRoot relativePath limit renderWidth query -> setCacheControl <$> serveFuzzyFind codebase (Left <$> mayRoot) relativePath limit renderWidth query) - :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTermSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth) - :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTypeSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth) - serveProjectsCodebaseServerAPI :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> @@ -587,35 +575,39 @@ serveProjectsCodebaseServerAPI codebase rt projectName branchName = do :<|> serveTypeSummaryEndpoint where projectAndBranchName = ProjectAndBranch projectName branchName - namespaceListingEndpoint _rootParam rel name = do - root <- resolveProjectRoot codebase projectAndBranchName - setCacheControl <$> NamespaceListing.serve codebase (Just . Right $ root) rel name - namespaceDetailsEndpoint namespaceName _rootParam renderWidth = do - root <- resolveProjectRoot codebase projectAndBranchName - setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Just . Right $ root) renderWidth - - serveDefinitionsEndpoint _rootParam relativePath rawHqns renderWidth suff = do - root <- resolveProjectRoot codebase projectAndBranchName - setCacheControl <$> serveDefinitions rt codebase (Just . Right $ root) relativePath rawHqns renderWidth suff - - serveFuzzyFindEndpoint _rootParam relativePath limit renderWidth query = do - root <- resolveProjectRoot codebase projectAndBranchName - setCacheControl <$> serveFuzzyFind codebase (Just . Right $ root) relativePath limit renderWidth query - - serveTermSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do - root <- resolveProjectRoot codebase projectAndBranchName - setCacheControl <$> serveTermSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth - - serveTypeSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do - root <- resolveProjectRoot codebase projectAndBranchName - setCacheControl <$> serveTypeSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth - -resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO CausalHash + namespaceListingEndpoint rel name = do + root <- resolveProjectRootHash codebase projectAndBranchName + setCacheControl <$> NamespaceListing.serve codebase (Right $ root) rel name + namespaceDetailsEndpoint namespaceName renderWidth = do + root <- resolveProjectRootHash codebase projectAndBranchName + setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Right $ root) renderWidth + + serveDefinitionsEndpoint relativePath rawHqns renderWidth suff = do + root <- resolveProjectRootHash codebase projectAndBranchName + setCacheControl <$> serveDefinitions rt codebase (Right $ root) relativePath rawHqns renderWidth suff + + serveFuzzyFindEndpoint relativePath limit renderWidth query = do + root <- resolveProjectRootHash codebase projectAndBranchName + setCacheControl <$> serveFuzzyFind codebase (Right $ root) relativePath limit renderWidth query + + serveTermSummaryEndpoint shortHash mayName relativeTo renderWidth = do + root <- resolveProjectRootHash codebase projectAndBranchName + setCacheControl <$> serveTermSummary codebase shortHash mayName (Right $ root) relativeTo renderWidth + + serveTypeSummaryEndpoint shortHash mayName relativeTo renderWidth = do + root <- resolveProjectRootHash codebase projectAndBranchName + setCacheControl <$> serveTypeSummary codebase shortHash mayName (Right $ root) relativeTo renderWidth + +resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO (V2.CausalBranch Sqlite.Transaction) resolveProjectRoot codebase projectAndBranchName@(ProjectAndBranch projectName branchName) = do - mayCH <- liftIO . Codebase.runTransaction codebase $ Backend.causalHashForProjectBranchName @IO projectAndBranchName - case mayCH of + mayCB <- liftIO . Codebase.runTransaction codebase $ Codebase.getShallowProjectRootByNames projectAndBranchName + case mayCB of Nothing -> throwError (Backend.ProjectBranchNameNotFound projectName branchName) - Just ch -> pure ch + Just cb -> pure cb + +resolveProjectRootHash :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO CausalHash +resolveProjectRootHash codebase projectAndBranchName = do + resolveProjectRoot codebase projectAndBranchName <&> Causal.causalHash serveProjectDiffTermsEndpoint :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ProjectName -> ProjectBranchName -> ProjectBranchName -> Name -> Name -> Backend IO TermDiffResponse serveProjectDiffTermsEndpoint codebase rt projectName oldBranchRef newBranchRef oldTerm newTerm = do @@ -638,7 +630,7 @@ serveProjectDiffTermsEndpoint codebase rt projectName oldBranchRef newBranchRef contextForProjectBranch :: (Codebase IO v a) -> ProjectName -> ProjectBranchName -> Backend IO (PrettyPrintEnvDecl, NameSearch Sqlite.Transaction) contextForProjectBranch codebase projectName branchName = do - projectRootHash <- resolveProjectRoot codebase (ProjectAndBranch projectName branchName) + projectRootHash <- resolveProjectRootHash codebase (ProjectAndBranch projectName branchName) projectRootBranch <- liftIO $ Codebase.expectBranchForHash codebase projectRootHash hashLength <- liftIO $ Codebase.runTransaction codebase $ Codebase.hashLength let names = Branch.toNames (Branch.head projectRootBranch) @@ -684,7 +676,7 @@ serveUnisonLocal :: Server UnisonLocalAPI serveUnisonLocal env codebase rt = hoistServer (Proxy @UnisonLocalAPI) (backendHandler env) $ - serveProjectsAPI codebase rt :<|> serveLooseCode codebase rt :<|> (setCacheControl <$> ucmServer codebase) + serveProjectsAPI codebase rt :<|> (setCacheControl <$> ucmServer codebase) backendHandler :: BackendEnv -> Backend IO a -> Handler a backendHandler env m = diff --git a/unison-share-api/src/Unison/Server/Doc.hs b/unison-share-api/src/Unison/Server/Doc.hs index cd4c811ad3..ec2ee1cd1d 100644 --- a/unison-share-api/src/Unison/Server/Doc.hs +++ b/unison-share-api/src/Unison/Server/Doc.hs @@ -333,11 +333,13 @@ evalDoc terms typeOf eval types tm = DD.Doc2SpecialFormExample n (DD.Doc2Example vs body) -> pure $ EExample ex where - ex = Term.lam' (ABT.annotation body) (drop (fromIntegral n) vs) body + annotatedVs = ((),) <$> vs + ex = Term.lam' (ABT.annotation body) (drop (fromIntegral n) annotatedVs) body DD.Doc2SpecialFormExampleBlock n (DD.Doc2Example vs body) -> pure $ EExampleBlock ex where - ex = Term.lam' (ABT.annotation body) (drop (fromIntegral n) vs) body + annotatedVs = ((),) <$> vs + ex = Term.lam' (ABT.annotation body) (drop (fromIntegral n) annotatedVs) body -- Link (Either Link.Type Doc2.Term) DD.Doc2SpecialFormLink e -> diff --git a/unison-share-api/src/Unison/Server/Local.hs b/unison-share-api/src/Unison/Server/Local.hs index f5c3525f46..04a6d9f411 100644 --- a/unison-share-api/src/Unison/Server/Local.hs +++ b/unison-share-api/src/Unison/Server/Local.hs @@ -41,11 +41,11 @@ relocateToNameRoot perspective query rootBranch = do -- Since the project root is lower down we need to strip the part of the prefix -- which is now redundant. pure . Right $ (projectRoot, query <&> \n -> fromMaybe n $ Path.unprefixName (Path.Absolute remainder) n) - -- The namesRoot is _inside_ of the project containing the query + -- The namesRoot is _inside (or equal to)_ the project containing the query (_sharedPrefix, remainder, Path.Empty) -> do -- Since the project is higher up, we need to prefix the query -- with the remainder of the path - pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.AbsolutePath' $ Path.Absolute remainder)) + pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.RelativePath' $ Path.Relative remainder)) -- The namesRoot and project root are disjoint, this shouldn't ever happen. (_, _, _) -> pure $ Left (DisjointProjectAndPerspective perspective projectRoot) diff --git a/unison-share-api/src/Unison/Server/Local/Definitions.hs b/unison-share-api/src/Unison/Server/Local/Definitions.hs index b1f5b03d52..11a2623154 100644 --- a/unison-share-api/src/Unison/Server/Local/Definitions.hs +++ b/unison-share-api/src/Unison/Server/Local/Definitions.hs @@ -20,7 +20,7 @@ import Unison.Codebase.Path (Path) import Unison.Codebase.Runtime qualified as Rt import Unison.DataDeclaration qualified as DD import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.NamesWithHistory qualified as NS import Unison.NamesWithHistory qualified as Names @@ -81,7 +81,7 @@ prettyDefinitionsForHQName perspective shallowRoot renderWidth suffixifyBindings -- ppe which returns names fully qualified to the current perspective, not to the codebase root. let biases = maybeToList $ HQ.toName query hqLength <- liftIO $ Codebase.runTransaction codebase $ Codebase.hashLength - (localNamesOnly, unbiasedPPED) <- namesAtPathFromRootBranchHash codebase (Just shallowRoot) namesRoot + (localNamesOnly, unbiasedPPED) <- namesAtPathFromRootBranchHash codebase shallowRoot namesRoot let pped = PPED.biasTo biases unbiasedPPED let nameSearch = makeNameSearch hqLength localNamesOnly (DefinitionResults terms types misses) <- liftIO $ Codebase.runTransaction codebase do diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs index 5cc218b7eb..7d082b8149 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs @@ -3,22 +3,16 @@ module Unison.Server.Local.Endpoints.Current where -import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema (..)) import Servant ((:>)) import Servant.Docs (ToSample (..)) -import U.Codebase.Sqlite.DbId -import U.Codebase.Sqlite.Project qualified as Project -import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path -import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName (..), ProjectName (..)) -import Unison.NameSegment (NameSegment) +import Unison.Codebase.ProjectPath qualified as PP +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.Prelude -import Unison.Project.Util (pattern BranchesNameSegment, pattern ProjectsNameSegment, pattern UUIDNameSegment) import Unison.Server.Backend import Unison.Server.Types (APIGet) @@ -40,7 +34,7 @@ instance ToSample Current where Current (Just $ UnsafeProjectName "@unison/base") (Just $ UnsafeProjectBranchName "main") - (Path.Absolute $ Path.unsafeParseText ".__projects._53393e4b_1f61_467c_a488_b6068c727daa.branches._f0aec0e3_249f_4004_b836_572fea3981c1") + (Path.Absolute $ Path.unsafeParseText "my.path") ) ] @@ -52,31 +46,11 @@ instance ToJSON Current where "path" .= path ] -serveCurrent :: MonadIO m => Codebase m v a -> Backend m Current +serveCurrent :: (MonadIO m) => Codebase m v a -> Backend m Current serveCurrent = lift . getCurrentProjectBranch -getCurrentProjectBranch :: MonadIO m => Codebase m v a -> m Current +getCurrentProjectBranch :: (MonadIO m) => Codebase m v a -> m Current getCurrentProjectBranch codebase = do - segments <- Codebase.runTransaction codebase Queries.expectMostRecentNamespace - let absolutePath = toPath segments - case toIds segments of - ProjectAndBranch (Just projectId) branchId -> - Codebase.runTransaction codebase do - project <- Queries.expectProject projectId - branch <- traverse (Queries.expectProjectBranch projectId) branchId - pure $ Current (Just $ Project.name project) (ProjectBranch.name <$> branch) absolutePath - ProjectAndBranch _ _ -> - pure $ Current Nothing Nothing absolutePath - where - toIds :: [NameSegment] -> ProjectAndBranch (Maybe ProjectId) (Maybe ProjectBranchId) - toIds segments = - case segments of - ProjectsNameSegment : UUIDNameSegment projectId : BranchesNameSegment : UUIDNameSegment branchId : _ -> - ProjectAndBranch {project = Just $ ProjectId projectId, branch = Just $ ProjectBranchId branchId} - ProjectsNameSegment : UUIDNameSegment projectId : _ -> - ProjectAndBranch {project = Just $ ProjectId projectId, branch = Nothing} - _ -> - ProjectAndBranch {project = Nothing, branch = Nothing} - - toPath :: [NameSegment] -> Path.Absolute - toPath = Path.Absolute . Path.fromList + pp <- Codebase.runTransaction codebase Codebase.expectCurrentProjectPath + let (PP.ProjectPath projName branchName path) = PP.toNames pp + pure $ Current (Just projName) (Just branchName) path diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs index 3de04b5054..93e3648678 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs @@ -67,7 +67,6 @@ type TermSummaryAPI = -- It's propagated through to the response as-is. -- If missing, the short hash will be used instead. :> QueryParam "name" Name - :> QueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "renderWidth" Width :> APIGet TermSummary @@ -98,11 +97,11 @@ serveTermSummary :: Codebase IO Symbol Ann -> Referent -> Maybe Name -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Width -> Backend IO TermSummary -serveTermSummary codebase referent mayName mayRoot relativeTo mayWidth = do +serveTermSummary codebase referent mayName root relativeTo mayWidth = do let shortHash = Referent.toShortHash referent let displayName = maybe (HQ.HashOnly shortHash) HQ.NameOnly mayName let relativeToPath = fromMaybe Path.empty relativeTo @@ -111,7 +110,7 @@ serveTermSummary codebase referent mayName mayRoot relativeTo mayWidth = do (root, sig) <- Backend.hoistBackend (Codebase.runTransaction codebase) do - root <- Backend.normaliseRootCausalHash mayRoot + root <- Backend.normaliseRootCausalHash root sig <- lift (Backend.loadReferentType codebase referent) pure (root, sig) case sig of @@ -126,7 +125,7 @@ serveTermSummary codebase referent mayName mayRoot relativeTo mayWidth = do namesPerspective <- Ops.namesPerspectiveForRootAndPath (V2Causal.valueHash root) (coerce . Path.toList $ fromMaybe Path.Empty relativeTo) PPESqlite.ppedForReferences namesPerspective deps False -> do - (_localNames, ppe) <- Backend.namesAtPathFromRootBranchHash codebase (Just root) relativeToPath + (_localNames, ppe) <- Backend.namesAtPathFromRootBranchHash codebase root relativeToPath pure ppe let formattedTermSig = Backend.formatSuffixedType ppe width typeSig let summary = mkSummary termReference formattedTermSig @@ -150,7 +149,6 @@ type TypeSummaryAPI = -- It's propagated through to the response as-is. -- If missing, the short hash will be used instead. :> QueryParam "name" Name - :> QueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "renderWidth" Width :> APIGet TypeSummary @@ -181,7 +179,7 @@ serveTypeSummary :: Codebase IO Symbol Ann -> Reference -> Maybe Name -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Width -> Backend IO TypeSummary diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs index 5aaa434463..cb05dc5d50 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs @@ -4,7 +4,6 @@ module Unison.Server.Local.Endpoints.FuzzyFind where -import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema) import Servant @@ -47,7 +46,6 @@ import Unison.Util.Pretty (Width) type FuzzyFindAPI = "find" - :> QueryParam "rootBranch" SCH.ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "limit" Int :> QueryParam "renderWidth" Width @@ -142,18 +140,18 @@ serveFuzzyFind :: forall m. (MonadIO m) => Codebase m Symbol Ann -> - Maybe (Either SCH.ShortCausalHash CausalHash) -> + Either SCH.ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Int -> Maybe Width -> Maybe String -> Backend.Backend m [(FZF.Alignment, FoundResult)] -serveFuzzyFind codebase mayRoot relativeTo limit typeWidth query = do +serveFuzzyFind codebase root relativeTo limit typeWidth query = do let path = fromMaybe Path.empty relativeTo rootCausal <- Backend.hoistBackend (Codebase.runTransaction codebase) do - Backend.normaliseRootCausalHash mayRoot - (localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase (Just rootCausal) path + Backend.normaliseRootCausalHash root + (localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase rootCausal path let alignments :: ( [ ( FZF.Alignment, UnisonName, diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs index 49a67357ea..86cb6288d6 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs @@ -44,7 +44,6 @@ import Unison.Util.Pretty (Width) type DefinitionsAPI = "getDefinition" - :> QueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParams "names" (HQ.HashQualified Name) :> QueryParam "renderWidth" Width @@ -96,16 +95,6 @@ instance ToParam (QueryParam "namespace" Path.Path) where ) Normal -instance ToParam (QueryParam "rootBranch" ShortCausalHash) where - toParam _ = - DocQueryParam - "rootBranch" - ["#abc123"] - ( "The hash or hash prefix of the namespace root. " - <> "If left absent, the most recent root will be used." - ) - Normal - instance ToParam (QueryParams "names" (HQ.HashQualified Name)) where toParam _ = DocQueryParam @@ -120,15 +109,15 @@ instance ToSample DefinitionDisplayResults where serveDefinitions :: Rt.Runtime Symbol -> Codebase IO Symbol Ann -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> [HQ.HashQualified Name] -> Maybe Width -> Maybe Suffixify -> Backend.Backend IO DefinitionDisplayResults -serveDefinitions rt codebase mayRoot relativePath hqns width suff = +serveDefinitions rt codebase root relativePath hqns width suff = do - rootCausalHash <- Backend.hoistBackend (Codebase.runTransaction codebase) . Backend.normaliseRootCausalHash $ mayRoot + rootCausalHash <- Backend.hoistBackend (Codebase.runTransaction codebase) . Backend.normaliseRootCausalHash $ root hqns & foldMapM ( Local.prettyDefinitionsForHQName diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs index bcb6ca5fa1..c0e2d94841 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs @@ -4,7 +4,6 @@ module Unison.Server.Local.Endpoints.NamespaceDetails where -import Control.Monad.Except import Data.Set qualified as Set import Servant (Capture, QueryParam, (:>)) import Servant.Docs (DocCapture (..), ToCapture (..)) @@ -33,7 +32,6 @@ import Unison.Util.Pretty (Width) type NamespaceDetailsAPI = "namespaces" :> Capture "namespace" Path.Path - :> QueryParam "rootBranch" ShortCausalHash :> QueryParam "renderWidth" Width :> APIGet NamespaceDetails @@ -47,23 +45,21 @@ namespaceDetails :: Rt.Runtime Symbol -> Codebase IO Symbol Ann -> Path.Path -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Width -> Backend IO NamespaceDetails -namespaceDetails runtime codebase namespacePath mayRoot _mayWidth = do +namespaceDetails runtime codebase namespacePath root _mayWidth = do (rootCausal, namespaceCausal, shallowBranch) <- Backend.hoistBackend (Codebase.runTransaction codebase) do rootCausalHash <- - case mayRoot of - Nothing -> Backend.resolveRootBranchHashV2 Nothing - Just (Left sch) -> Backend.resolveRootBranchHashV2 (Just sch) - Just (Right ch) -> lift $ Backend.resolveCausalHashV2 (Just ch) - -- lift (Backend.resolveCausalHashV2 rootCausalHash) - namespaceCausal <- lift $ Codebase.getShallowCausalAtPath namespacePath (Just rootCausalHash) + case root of + (Left sch) -> Backend.resolveRootBranchHashV2 sch + (Right ch) -> lift $ Codebase.expectCausalBranchByCausalHash ch + namespaceCausal <- lift $ Codebase.getShallowCausalAtPath namespacePath rootCausalHash shallowBranch <- lift $ V2Causal.value namespaceCausal pure (rootCausalHash, namespaceCausal, shallowBranch) namespaceDetails <- do - (_localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase (Just rootCausal) namespacePath + (_localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase rootCausal namespacePath let mayReadmeRef = Backend.findDocInBranch readmeNames shallowBranch renderedReadme <- for mayReadmeRef \readmeRef -> do -- Local server currently ignores eval errors. diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs index fe5e5ee06a..c60357548d 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs @@ -4,7 +4,6 @@ module Unison.Server.Local.Endpoints.NamespaceListing (serve, NamespaceListingAPI, NamespaceListing (..), NamespaceObject (..), NamedNamespace (..), NamedPatch (..), KindExpression (..)) where -import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema) import Servant @@ -47,7 +46,6 @@ import Unison.Var (Var) type NamespaceListingAPI = "list" - :> QueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "namespace" Path.Path :> APIGet NamespaceListing @@ -192,12 +190,12 @@ backendListEntryToNamespaceObject ppe typeWidth = \case serve :: Codebase IO Symbol Ann -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Path.Path -> Backend.Backend IO NamespaceListing -serve codebase maySCH mayRelativeTo mayNamespaceName = do - rootCausal <- Backend.hoistBackend (Codebase.runTransaction codebase) $ Backend.normaliseRootCausalHash maySCH +serve codebase root mayRelativeTo mayNamespaceName = do + rootCausal <- Backend.hoistBackend (Codebase.runTransaction codebase) $ Backend.normaliseRootCausalHash root -- Relative and Listing Path resolution -- @@ -217,7 +215,7 @@ serve codebase maySCH mayRelativeTo mayNamespaceName = do let path = relativeToPath <> namespacePath (listingCausal, listingBranch) <- (lift . Codebase.runTransaction codebase) do - listingCausal <- Codebase.getShallowCausalAtPath path (Just rootCausal) + listingCausal <- Codebase.getShallowCausalAtPath path rootCausal listingBranch <- V2Causal.value listingCausal pure (listingCausal, listingBranch) -- TODO: Currently the ppe is just used to render the types returned from the namespace diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs index d657a23e13..09ed27a12b 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs @@ -11,5 +11,5 @@ import Unison.Server.Local.Endpoints.Current (Current, CurrentEndpoint, serveCur type UCMAPI = CurrentEndpoint -ucmServer :: MonadIO m => Codebase m v a -> Backend m Current +ucmServer :: (MonadIO m) => Codebase m v a -> Backend m Current ucmServer codebase = serveCurrent codebase diff --git a/unison-share-api/src/Unison/Server/NameSearch.hs b/unison-share-api/src/Unison/Server/NameSearch.hs index 2336d3241b..5e61cd8c30 100644 --- a/unison-share-api/src/Unison/Server/NameSearch.hs +++ b/unison-share-api/src/Unison/Server/NameSearch.hs @@ -12,7 +12,7 @@ import Control.Lens import Data.List qualified as List import Data.Set qualified as Set import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.NamesWithHistory (SearchType (..)) import Unison.Prelude diff --git a/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs b/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs index a78fc6f6f8..40a4ad4d29 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs +++ b/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs @@ -1,6 +1,6 @@ module Unison.Server.NameSearch.FromNames where -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Names (Names) import Unison.NamesWithHistory qualified as Names import Unison.Reference (Reference) diff --git a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs index 527c8bd634..8095d5bdce 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs +++ b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs @@ -17,7 +17,7 @@ import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name diff --git a/unison-share-api/src/Unison/Server/Orphans.hs b/unison-share-api/src/Unison/Server/Orphans.hs index 7451d2f183..bfe22d6716 100644 --- a/unison-share-api/src/Unison/Server/Orphans.hs +++ b/unison-share-api/src/Unison/Server/Orphans.hs @@ -26,7 +26,7 @@ import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.Hash (Hash (..)) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment.Internal (NameSegment (NameSegment)) @@ -37,7 +37,7 @@ import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH import Unison.Syntax.HashQualified qualified as HQ (parseText) -import Unison.Syntax.HashQualified' qualified as HQ' (parseText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (parseText) import Unison.Syntax.Name qualified as Name (parseTextEither, toText) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Pretty (Width (..)) diff --git a/unison-share-api/src/Unison/Server/SearchResult.hs b/unison-share-api/src/Unison/Server/SearchResult.hs index c30c16634a..9dd8d09046 100644 --- a/unison-share-api/src/Unison/Server/SearchResult.hs +++ b/unison-share-api/src/Unison/Server/SearchResult.hs @@ -2,7 +2,7 @@ module Unison.Server.SearchResult where import Data.Set qualified as Set import Unison.HashQualified (HashQualified) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names (..)) diff --git a/unison-share-api/src/Unison/Server/SearchResult'.hs b/unison-share-api/src/Unison/Server/SearchResultPrime.hs similarity index 96% rename from unison-share-api/src/Unison/Server/SearchResult'.hs rename to unison-share-api/src/Unison/Server/SearchResultPrime.hs index d928811ed5..b24c9f2c8a 100644 --- a/unison-share-api/src/Unison/Server/SearchResult'.hs +++ b/unison-share-api/src/Unison/Server/SearchResultPrime.hs @@ -1,6 +1,6 @@ {-# LANGUAGE PatternSynonyms #-} -module Unison.Server.SearchResult' where +module Unison.Server.SearchResultPrime where import Data.Set qualified as Set import Unison.Codebase.Editor.DisplayObject (DisplayObject) @@ -8,7 +8,7 @@ import Unison.Codebase.Editor.DisplayObject qualified as DT import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DD import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) diff --git a/unison-share-api/src/Unison/Server/Types.hs b/unison-share-api/src/Unison/Server/Types.hs index 48f9ace2bc..6139c395af 100644 --- a/unison-share-api/src/Unison/Server/Types.hs +++ b/unison-share-api/src/Unison/Server/Types.hs @@ -20,6 +20,7 @@ import Data.OpenApi.Lens qualified as OpenApi import Data.Text qualified as Text import Data.Text.Lazy qualified as Text.Lazy import Data.Text.Lazy.Encoding qualified as Text +import Servant qualified import Servant.API ( Capture, FromHttpApiData (..), @@ -41,7 +42,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Core.Project (ProjectBranchName) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Prelude import Unison.Project (ProjectAndBranch, ProjectName) @@ -104,7 +105,7 @@ data ExactName name ref = ExactName { name :: name, ref :: ref } - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance ToParamSchema (ExactName Name ShortHash) where toParamSchema _ = @@ -540,3 +541,6 @@ instance ToJSON TypeDiffResponse where "oldType" .= oldType, "newType" .= newType ] + +-- | Servant utility for a query param that's required, providing a useful error message if it's missing. +type RequiredQueryParam = Servant.QueryParam' '[Servant.Required, Servant.Strict] diff --git a/unison-share-api/src/Unison/Sync/API.hs b/unison-share-api/src/Unison/Sync/API.hs index 754931f8b1..5cafebdfc3 100644 --- a/unison-share-api/src/Unison/Sync/API.hs +++ b/unison-share-api/src/Unison/Sync/API.hs @@ -11,8 +11,6 @@ api = Proxy type API = "path" :> "get" :> GetCausalHashByPathEndpoint - :<|> "path" :> "fast-forward" :> FastForwardPathEndpoint - :<|> "path" :> "update" :> UpdatePathEndpoint :<|> "entities" :> "download" :> DownloadEntitiesEndpoint :<|> "entities" :> "upload" :> UploadEntitiesEndpoint @@ -20,14 +18,6 @@ type GetCausalHashByPathEndpoint = ReqBody '[JSON] GetCausalHashByPathRequest :> Post '[JSON] GetCausalHashByPathResponse -type FastForwardPathEndpoint = - ReqBody '[JSON] FastForwardPathRequest - :> Post '[JSON] FastForwardPathResponse - -type UpdatePathEndpoint = - ReqBody '[JSON] UpdatePathRequest - :> Post '[JSON] UpdatePathResponse - type DownloadEntitiesEndpoint = ReqBody '[JSON] DownloadEntitiesRequest :> Post '[JSON] DownloadEntitiesResponse diff --git a/unison-share-api/src/Unison/Sync/Types.hs b/unison-share-api/src/Unison/Sync/Types.hs index ccd680135f..35d7030cc8 100644 --- a/unison-share-api/src/Unison/Sync/Types.hs +++ b/unison-share-api/src/Unison/Sync/Types.hs @@ -48,17 +48,6 @@ module Unison.Sync.Types UploadEntitiesResponse (..), UploadEntitiesError (..), - -- ** Fast-forward path - FastForwardPathRequest (..), - FastForwardPathResponse (..), - FastForwardPathError (..), - - -- ** Update path - UpdatePathRequest (..), - UpdatePathResponse (..), - UpdatePathError (..), - HashMismatch (..), - -- * Common/shared error types HashMismatchForEntity (..), InvalidParentage (..), @@ -203,7 +192,7 @@ entityDependencies = \case C Causal {namespaceHash, parents} -> Set.insert namespaceHash parents data TermComponent text hash = TermComponent [(LocalIds text hash, ByteString)] - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance Bifoldable TermComponent where bifoldMap = bifoldMapDefault @@ -252,7 +241,7 @@ decodeComponentPiece = Aeson.withObject "Component Piece" \obj -> do pure (localIDs, bytes) data DeclComponent text hash = DeclComponent [(LocalIds text hash, ByteString)] - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance Bifoldable DeclComponent where bifoldMap = bifoldMapDefault @@ -280,7 +269,7 @@ data LocalIds text hash = LocalIds { texts :: [text], hashes :: [hash] } - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance Bifoldable LocalIds where bifoldMap = bifoldMapDefault @@ -381,7 +370,7 @@ data Namespace text hash = Namespace childLookup :: [(hash, hash)], -- (namespace hash, causal hash) bytes :: LocalBranchBytes } - deriving stock (Eq, Ord, Show) + deriving stock (Eq, Functor, Ord, Show) instance Bifoldable Namespace where bifoldMap = bifoldMapDefault @@ -751,111 +740,9 @@ instance FromJSON HashMismatchForEntity where <*> obj .: "computed" ------------------------------------------------------------------------------------------------------------------------- --- Fast-forward path - --- | A non-empty list of causal hashes, latest first, that show the lineage from wherever the client wants to --- fast-forward to back to wherever the (client believes the) server is (including the server head, in a separate --- field). --- --- For example, if the client wants to update --- --- @ --- A -> B -> C --- @ --- --- to --- --- @ --- A -> B -> C -> D -> E -> F --- @ --- --- then it would send hashes --- --- @ --- expectedHash = C --- hashes = [D, E, F] --- @ --- --- Note that if the client wants to begin a history at a new path on the server, it would use the "update path" endpoint --- instead. -data FastForwardPathRequest = FastForwardPathRequest - { -- | The causal that the client believes exists at `path` - expectedHash :: Hash32, - -- | The sequence of causals to fast-forward with, starting from the oldest new causal to the newest new causal - hashes :: NonEmpty Hash32, - -- | The path to fast-forward - path :: Path - } - deriving stock (Show) - -instance ToJSON FastForwardPathRequest where - toJSON FastForwardPathRequest {expectedHash, hashes, path} = - object - [ "expected_hash" .= expectedHash, - "hashes" .= hashes, - "path" .= path - ] - -instance FromJSON FastForwardPathRequest where - parseJSON = - Aeson.withObject "FastForwardPathRequest" \o -> do - expectedHash <- o .: "expected_hash" - hashes <- o .: "hashes" - path <- o .: "path" - pure FastForwardPathRequest {expectedHash, hashes, path} - -data FastForwardPathResponse - = FastForwardPathSuccess - | FastForwardPathFailure FastForwardPathError - deriving stock (Show) - -data FastForwardPathError - = FastForwardPathError'MissingDependencies (NeedDependencies Hash32) - | FastForwardPathError'NoWritePermission Path - | -- | This wasn't a fast-forward. Here's a JWT to download the causal head, if you want it. - FastForwardPathError'NotFastForward HashJWT - | -- | There was no history at this path; the client should use the "update path" endpoint instead. - FastForwardPathError'NoHistory - | -- | This wasn't a fast-forward. You said the first hash was a parent of the second hash, but I disagree. - FastForwardPathError'InvalidParentage InvalidParentage - | FastForwardPathError'InvalidRepoInfo Text RepoInfo - | FastForwardPathError'UserNotFound - deriving stock (Show) - data InvalidParentage = InvalidParentage {parent :: Hash32, child :: Hash32} deriving stock (Show) -instance ToJSON FastForwardPathResponse where - toJSON = \case - FastForwardPathSuccess -> jsonUnion "success" (Object mempty) - (FastForwardPathFailure (FastForwardPathError'MissingDependencies deps)) -> jsonUnion "missing_dependencies" deps - (FastForwardPathFailure (FastForwardPathError'NoWritePermission path)) -> jsonUnion "no_write_permission" path - (FastForwardPathFailure (FastForwardPathError'NotFastForward hashJwt)) -> jsonUnion "not_fast_forward" hashJwt - (FastForwardPathFailure FastForwardPathError'NoHistory) -> jsonUnion "no_history" (Object mempty) - (FastForwardPathFailure (FastForwardPathError'InvalidParentage invalidParentage)) -> - jsonUnion "invalid_parentage" invalidParentage - (FastForwardPathFailure (FastForwardPathError'InvalidRepoInfo msg repoInfo)) -> - jsonUnion "invalid_repo_info" (msg, repoInfo) - (FastForwardPathFailure FastForwardPathError'UserNotFound) -> - jsonUnion "user_not_found" (Object mempty) - -instance FromJSON FastForwardPathResponse where - parseJSON = - Aeson.withObject "FastForwardPathResponse" \o -> - o .: "type" >>= Aeson.withText "type" \case - "success" -> pure FastForwardPathSuccess - "missing_dependencies" -> FastForwardPathFailure . FastForwardPathError'MissingDependencies <$> o .: "payload" - "no_write_permission" -> FastForwardPathFailure . FastForwardPathError'NoWritePermission <$> o .: "payload" - "not_fast_forward" -> FastForwardPathFailure . FastForwardPathError'NotFastForward <$> o .: "payload" - "no_history" -> pure (FastForwardPathFailure FastForwardPathError'NoHistory) - "invalid_parentage" -> FastForwardPathFailure . FastForwardPathError'InvalidParentage <$> o .: "payload" - "invalid_repo_info" -> do - (msg, repoInfo) <- o .: "payload" - pure (FastForwardPathFailure (FastForwardPathError'InvalidRepoInfo msg repoInfo)) - "user_not_found" -> pure (FastForwardPathFailure FastForwardPathError'UserNotFound) - t -> failText $ "Unexpected FastForwardPathResponse type: " <> t - instance ToJSON InvalidParentage where toJSON (InvalidParentage parent child) = object ["parent" .= parent, "child" .= child] @@ -863,89 +750,6 @@ instance FromJSON InvalidParentage where parseJSON = Aeson.withObject "InvalidParentage" \o -> InvalidParentage <$> o .: "parent" <*> o .: "child" ------------------------------------------------------------------------------------------------------------------------- --- Update path - -data UpdatePathRequest = UpdatePathRequest - { path :: Path, - expectedHash :: Maybe Hash32, -- Nothing requires empty history at destination - newHash :: Hash32 - } - deriving stock (Show, Eq, Ord) - -instance ToJSON UpdatePathRequest where - toJSON (UpdatePathRequest path expectedHash newHash) = - object - [ "path" .= path, - "expected_hash" .= expectedHash, - "new_hash" .= newHash - ] - -instance FromJSON UpdatePathRequest where - parseJSON = Aeson.withObject "UpdatePathRequest" \obj -> do - path <- obj .: "path" - expectedHash <- obj .: "expected_hash" - newHash <- obj .: "new_hash" - pure UpdatePathRequest {..} - -data UpdatePathResponse - = UpdatePathSuccess - | UpdatePathFailure UpdatePathError - deriving stock (Show, Eq, Ord) - -data UpdatePathError - = UpdatePathError'HashMismatch HashMismatch - | UpdatePathError'InvalidRepoInfo Text RepoInfo -- err msg, repo info - | UpdatePathError'MissingDependencies (NeedDependencies Hash32) - | UpdatePathError'NoWritePermission Path - | UpdatePathError'UserNotFound - deriving stock (Show, Eq, Ord) - -instance ToJSON UpdatePathResponse where - toJSON = \case - UpdatePathSuccess -> jsonUnion "success" (Object mempty) - UpdatePathFailure (UpdatePathError'HashMismatch hm) -> jsonUnion "hash_mismatch" hm - UpdatePathFailure (UpdatePathError'MissingDependencies md) -> jsonUnion "missing_dependencies" md - UpdatePathFailure (UpdatePathError'NoWritePermission path) -> jsonUnion "no_write_permission" path - UpdatePathFailure (UpdatePathError'InvalidRepoInfo errMsg repoInfo) -> jsonUnion "invalid_repo_info" (errMsg, repoInfo) - UpdatePathFailure UpdatePathError'UserNotFound -> jsonUnion "user_not_found" (Object mempty) - -instance FromJSON UpdatePathResponse where - parseJSON v = - v & Aeson.withObject "UpdatePathResponse" \obj -> - obj .: "type" >>= Aeson.withText "type" \case - "success" -> pure UpdatePathSuccess - "hash_mismatch" -> UpdatePathFailure . UpdatePathError'HashMismatch <$> obj .: "payload" - "missing_dependencies" -> UpdatePathFailure . UpdatePathError'MissingDependencies <$> obj .: "payload" - "no_write_permission" -> UpdatePathFailure . UpdatePathError'NoWritePermission <$> obj .: "payload" - "invalid_repo_info" -> do - (errMsg, repoInfo) <- obj .: "payload" - pure (UpdatePathFailure (UpdatePathError'InvalidRepoInfo errMsg repoInfo)) - "user_not_found" -> pure (UpdatePathFailure UpdatePathError'UserNotFound) - t -> failText $ "Unexpected UpdatePathResponse type: " <> t - -data HashMismatch = HashMismatch - { path :: Path, - expectedHash :: Maybe Hash32, - actualHash :: Maybe Hash32 - } - deriving stock (Show, Eq, Ord) - -instance ToJSON HashMismatch where - toJSON (HashMismatch path expectedHash actualHash) = - object - [ "path" .= path, - "expected_hash" .= expectedHash, - "actual_hash" .= actualHash - ] - -instance FromJSON HashMismatch where - parseJSON = Aeson.withObject "HashMismatch" \obj -> do - path <- obj .: "path" - expectedHash <- obj .: "expected_hash" - actualHash <- obj .: "actual_hash" - pure HashMismatch {..} - ------------------------------------------------------------------------------------------------------------------------ -- Common/shared error types diff --git a/unison-share-api/src/Unison/Util/Find.hs b/unison-share-api/src/Unison/Util/Find.hs index 22923d7b03..792d439b24 100644 --- a/unison-share-api/src/Unison/Util/Find.hs +++ b/unison-share-api/src/Unison/Util/Find.hs @@ -15,7 +15,7 @@ import Data.Text qualified as Text -- https://www.stackage.org/haddock/lts-13.9/regex-tdfa-1.2.3.1/Text-Regex-TDFA.html import Text.Regex.TDFA qualified as RE import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) diff --git a/unison-share-api/unison-share-api.cabal b/unison-share-api/unison-share-api.cabal index 3741a18615..e3878a9e7f 100644 --- a/unison-share-api/unison-share-api.cabal +++ b/unison-share-api/unison-share-api.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -41,7 +41,7 @@ library Unison.Server.Orphans Unison.Server.QueryResult Unison.Server.SearchResult - Unison.Server.SearchResult' + Unison.Server.SearchResultPrime Unison.Server.Syntax Unison.Server.Types Unison.Sync.API @@ -84,7 +84,6 @@ library ghc-options: -Wall build-depends: Diff - , NanoID , aeson >=2.0.0.0 , async , base @@ -92,6 +91,7 @@ library , bytes , bytestring , containers + , cryptonite , directory , errors , extra diff --git a/unison-share-projects-api/src/Unison/Share/API/Hash.hs b/unison-share-projects-api/src/Unison/Share/API/Hash.hs index 1d975300a2..dfa1d1f44c 100644 --- a/unison-share-projects-api/src/Unison/Share/API/Hash.hs +++ b/unison-share-projects-api/src/Unison/Share/API/Hash.hs @@ -1,4 +1,9 @@ {-# LANGUAGE RecordWildCards #-} +-- Manipulating JWT claims with addClaim etc. directly is deprecated, so we'll need to fix that eventually. +-- The new way appears to be to define custom types with JSON instances and use those to encode/decode the JWT; +-- see https://github.com/frasertweedale/hs-jose/issues/116 +-- https://github.com/unisonweb/unison/issues/5153 +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Hash-related types in the Share API. module Unison.Share.API.Hash diff --git a/unison-src/builtin-tests/base.md b/unison-src/builtin-tests/base.md index d4717fdcc1..70443ad0f7 100644 --- a/unison-src/builtin-tests/base.md +++ b/unison-src/builtin-tests/base.md @@ -5,7 +5,7 @@ Thus, make sure the contents of this file define the contents of the cache (e.g. don't pull `latest`.) ```ucm -.> pull @unison/base/releases/2.5.0 .base -.> builtins.mergeio -.> undo +scratch/main> pull @unison/base/releases/2.5.0 .base +scratch/main> builtins.mergeio +scratch/main> undo ``` diff --git a/unison-src/builtin-tests/interpreter-tests.output.md b/unison-src/builtin-tests/interpreter-tests.output.md index 9257063d78..7ba9ed8bb7 100644 --- a/unison-src/builtin-tests/interpreter-tests.output.md +++ b/unison-src/builtin-tests/interpreter-tests.output.md @@ -4,7 +4,7 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. -```ucm +``` ucm runtime-tests/selected> run tests () diff --git a/unison-src/builtin-tests/interpreter-tests.tpl.md b/unison-src/builtin-tests/interpreter-tests.tpl.md index 2d09efdc0e..9e34968a78 100644 --- a/unison-src/builtin-tests/interpreter-tests.tpl.md +++ b/unison-src/builtin-tests/interpreter-tests.tpl.md @@ -5,12 +5,12 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. ```ucm:hide:error -.> this is a hack to trigger an error, in order to swallow any error on the next line. -.> we delete the project to avoid any merge conflicts or complaints from ucm. -.> delete.project runtime-tests +scratch/main> this is a hack to trigger an error, in order to swallow any error on the next line. +scratch/main> we delete the project to avoid any merge conflicts or complaints from ucm. +scratch/main> delete.project runtime-tests ``` ```ucm:hide -.> clone ${runtime_tests_version} runtime-tests/selected +scratch/main> clone ${runtime_tests_version} runtime-tests/selected ``` ```ucm diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 55c9234d59..616d2d5d9c 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -4,7 +4,7 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. -```ucm +``` ucm runtime-tests/selected> run.native tests () @@ -17,7 +17,8 @@ runtime-tests/selected> run.native tests.jit.only Per Dan: It's testing a flaw in how we were sending code from a scratch file to the native runtime, when that happened multiple times. Related to the verifiable refs and recursive functions. -```unison + +``` unison foo = do go : Nat ->{Exception} () go = cases @@ -26,7 +27,7 @@ foo = do go 1000 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -39,12 +40,12 @@ foo = do foo : '{Exception} () ``` -```ucm -.> run.native foo +``` ucm +scratch/main> run.native foo () -.> run.native foo +scratch/main> run.native foo () @@ -53,7 +54,7 @@ This can also only be tested by separately running this test, because it is exercising the protocol that ucm uses to talk to the jit during an exception. -```ucm +``` ucm runtime-tests/selected> run.native testBug 💔💥 diff --git a/unison-src/builtin-tests/jit-tests.sh b/unison-src/builtin-tests/jit-tests.sh index d4d9356ab1..8e29209dc1 100755 --- a/unison-src/builtin-tests/jit-tests.sh +++ b/unison-src/builtin-tests/jit-tests.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env sh set -ex # the first arg is the path to the unison executable @@ -8,9 +8,6 @@ if [ -z "$1" ]; then exit 1 fi -# call unison with all its args quoted -ucm=("$@") - runtime_tests_version="@unison/runtime-tests/main" echo $runtime_tests_version @@ -27,4 +24,5 @@ runtime_tests_version="$runtime_tests_version" \ < unison-src/builtin-tests/jit-tests.tpl.md \ > unison-src/builtin-tests/jit-tests.md -time "${ucm[@]}" transcript.fork -C $codebase -S $codebase unison-src/builtin-tests/jit-tests.md +# call unison with all its args quoted +time "$@" transcript.fork -C $codebase -S $codebase unison-src/builtin-tests/jit-tests.md diff --git a/unison-src/builtin-tests/jit-tests.tpl.md b/unison-src/builtin-tests/jit-tests.tpl.md index b24a7c7c7c..ea4a65793d 100644 --- a/unison-src/builtin-tests/jit-tests.tpl.md +++ b/unison-src/builtin-tests/jit-tests.tpl.md @@ -5,12 +5,12 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. ```ucm:hide:error -.> this is a hack to trigger an error, in order to swallow any error on the next line. -.> we delete the project to avoid any merge conflicts or complaints from ucm. -.> delete.project runtime-tests +scratch/main> this is a hack to trigger an error, in order to swallow any error on the next line. +scratch/main> we delete the project to avoid any merge conflicts or complaints from ucm. +scratch/main> delete.project runtime-tests ``` ```ucm:hide -.> clone ${runtime_tests_version} runtime-tests/selected +scratch/main> clone ${runtime_tests_version} runtime-tests/selected ``` ```ucm @@ -31,8 +31,8 @@ foo = do ``` ```ucm -.> run.native foo -.> run.native foo +scratch/main> run.native foo +scratch/main> run.native foo ``` This can also only be tested by separately running this test, because diff --git a/unison-src/transcripts-manual/benchmarks.md b/unison-src/transcripts-manual/benchmarks.md index 0a8ff9358c..2a3fe38a66 100644 --- a/unison-src/transcripts-manual/benchmarks.md +++ b/unison-src/transcripts-manual/benchmarks.md @@ -1,6 +1,6 @@ ```ucm:hide -.> pull unison.public.base.releases.M4d base -.> pull runarorama.public.sort.data sort +scratch/main> pull unison.public.base.releases.M4d base +scratch/main> pull runarorama.public.sort.data sort ``` ```unison:hide @@ -34,63 +34,63 @@ prepare = do ``` ```ucm:hide -.> add -.> run prepare +scratch/main> add +scratch/main> run prepare ``` ## Benchmarks ```ucm -.> load unison-src/transcripts-manual/benchmarks/each.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/each.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/listmap.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/listmap.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/listfilter.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/listfilter.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/random.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/random.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/simpleloop.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/simpleloop.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/fibonacci.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/fibonacci.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/map.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/map.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/natmap.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/natmap.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/stm.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/stm.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/tmap.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/tmap.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/array-sort.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/array-sort.u +scratch/main> run main ``` \ No newline at end of file diff --git a/unison-src/transcripts-manual/docs.to-html.md b/unison-src/transcripts-manual/docs.to-html.md new file mode 100644 index 0000000000..282de4e5e5 --- /dev/null +++ b/unison-src/transcripts-manual/docs.to-html.md @@ -0,0 +1,19 @@ +```ucm +test-html-docs/main> builtins.mergeio lib.builtins +``` + +```unison +{{A doc directly in the namespace.}} +some.ns.direct = 1 + +{{A doc pretty deeply nested in the namespace.}} +some.ns.pretty.deeply.nested = 2 + +{{A doc outside the namespace.}} +some.outside = 3 +``` + +```ucm +test-html-docs/main> add +test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html +``` diff --git a/unison-src/transcripts-manual/docs.to-html.output.md b/unison-src/transcripts-manual/docs.to-html.output.md new file mode 100644 index 0000000000..5c938806be --- /dev/null +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -0,0 +1,50 @@ +``` ucm +test-html-docs/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +{{A doc directly in the namespace.}} +some.ns.direct = 1 + +{{A doc pretty deeply nested in the namespace.}} +some.ns.pretty.deeply.nested = 2 + +{{A doc outside the namespace.}} +some.outside = 3 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + some.ns.direct : Nat + some.ns.direct.doc : Doc2 + some.ns.pretty.deeply.nested : Nat + some.ns.pretty.deeply.nested.doc : Doc2 + some.outside : Nat + some.outside.doc : Doc2 + +``` +``` ucm +test-html-docs/main> add + + ⍟ I've added these definitions: + + some.ns.direct : Nat + some.ns.direct.doc : Doc2 + some.ns.pretty.deeply.nested : Nat + some.ns.pretty.deeply.nested.doc : Doc2 + some.outside : Nat + some.outside.doc : Doc2 + +test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html + +``` diff --git a/unison-src/transcripts-manual/docs.to-html/direct/doc.html b/unison-src/transcripts-manual/docs.to-html/direct/doc.html new file mode 100644 index 0000000000..0e9f37a540 --- /dev/null +++ b/unison-src/transcripts-manual/docs.to-html/direct/doc.html @@ -0,0 +1 @@ +
A doc directly in the namespace.
\ No newline at end of file diff --git a/unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html b/unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html new file mode 100644 index 0000000000..1e5a75f500 --- /dev/null +++ b/unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html @@ -0,0 +1 @@ +
A doc pretty deeply nested in the namespace.
\ No newline at end of file diff --git a/unison-src/transcripts-manual/gen-racket-libs.md b/unison-src/transcripts-manual/gen-racket-libs.md index 811ec14f50..178503c969 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.md +++ b/unison-src/transcripts-manual/gen-racket-libs.md @@ -4,7 +4,7 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ```ucm -jit-setup/main> lib.install @unison/internal/releases/0.0.17 +jit-setup/main> lib.install @unison/internal/releases/0.0.18 ``` ```unison diff --git a/unison-src/transcripts-manual/gen-racket-libs.output.md b/unison-src/transcripts-manual/gen-racket-libs.output.md index 241a9cdc59..1e003ab489 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.output.md +++ b/unison-src/transcripts-manual/gen-racket-libs.output.md @@ -4,29 +4,12 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ```ucm -.> project.create-empty jit-setup +jit-setup/main> lib.install @unison/internal/releases/0.0.18 - 🎉 I've created the project jit-setup. + Downloaded 14917 entities. - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -jit-setup/main> pull @unison/internal/releases/0.0.17 lib.jit - - Downloaded 15091 entities. - - ✅ - - Successfully pulled into lib.jit, which was empty. + I installed @unison/internal/releases/0.0.18 as + unison_internal_0_0_18. ``` ```unison diff --git a/unison-src/transcripts-manual/remote-tab-completion.md b/unison-src/transcripts-manual/remote-tab-completion.md index da783b9de7..55b4adeec1 100644 --- a/unison-src/transcripts-manual/remote-tab-completion.md +++ b/unison-src/transcripts-manual/remote-tab-completion.md @@ -3,5 +3,5 @@ Note: this makes a network call to share to get completions ```ucm -.> debug.tab-complete pull unison.pub +scratch/main> debug.tab-complete pull unison.pub ``` diff --git a/unison-src/transcripts-manual/rewrites.md b/unison-src/transcripts-manual/rewrites.md index 15a5a06387..891cf53bd1 100644 --- a/unison-src/transcripts-manual/rewrites.md +++ b/unison-src/transcripts-manual/rewrites.md @@ -1,8 +1,8 @@ ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` ## Structural find and replace @@ -37,19 +37,19 @@ rule2 x = @rewrite signature Optional ==> Optional2 Let's rewrite these: ```ucm -.> rewrite rule1 -.> rewrite eitherToOptional +scratch/main> rewrite rule1 +scratch/main> rewrite eitherToOptional ``` ```ucm:hide -.> load -.> add +scratch/main> load +scratch/main> add ``` After adding to the codebase, here's the rewritten source: ```ucm -.> view ex1 Either.mapRight rule1 +scratch/main> view ex1 Either.mapRight rule1 ``` Another example, showing that we can rewrite to definitions that only exist in the file: @@ -75,18 +75,18 @@ blah2 = 456 Let's apply the rewrite `woot1to2`: ```ucm -.> rewrite woot1to2 +scratch/main> rewrite woot1to2 ``` ```ucm:hide -.> load -.> add +scratch/main> load +scratch/main> add ``` After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`: ```ucm -.> view wootEx +scratch/main> view wootEx ``` This example shows that rewrite rules can to refer to term definitions that only exist in the file: @@ -111,15 +111,15 @@ sameFileEx = ``` ```ucm:hide -.> rewrite rule -.> load -.> add +scratch/main> rewrite rule +scratch/main> load +scratch/main> add ``` After adding the rewritten form to the codebase, here's the rewritten definitions: ```ucm -.> view foo1 foo2 sameFileEx +scratch/main> view foo1 foo2 sameFileEx ``` ## Capture avoidance @@ -145,13 +145,13 @@ sameFileEx = In the above example, `bar2` is locally bound by the rule, so when applied, it should not refer to the `bar2` top level binding. ```ucm -.> rewrite rule +scratch/main> rewrite rule ``` Instead, it should be an unbound free variable, which doesn't typecheck: ```ucm:error -.> load +scratch/main> load ``` In this example, the `a` is locally bound by the rule, so it shouldn't capture the `a = 39494` binding which is in scope at the point of the replacement: @@ -167,13 +167,13 @@ rule a = @rewrite ``` ```ucm -.> rewrite rule +scratch/main> rewrite rule ``` The `a` introduced will be freshened to not capture the `a` in scope, so it remains as an unbound variable and is a type error: ```ucm:error -.> load +scratch/main> load ``` ## Structural find @@ -183,7 +183,7 @@ eitherEx = Left ("hello", "there") ``` ```ucm:hide -.> add +scratch/main> add ``` ```unison:hide @@ -192,7 +192,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` ```ucm -.> sfind findEitherEx -.> sfind findEitherFailure -.> find 1-5 +scratch/main> sfind findEitherEx +scratch/main> sfind findEitherFailure +scratch/main> find 1-5 ``` diff --git a/unison-src/transcripts-manual/rewrites.output.md b/unison-src/transcripts-manual/rewrites.output.md index a4764c7735..26cd59b494 100644 --- a/unison-src/transcripts-manual/rewrites.output.md +++ b/unison-src/transcripts-manual/rewrites.output.md @@ -1,9 +1,8 @@ - ## Structural find and replace Here's a scratch file with some rewrite rules: -```unison +``` unison ex1 = List.map (x -> x + 1) [1,2,3,4,5,6,7] eitherToOptional e a = @@ -30,8 +29,8 @@ rule2 x = @rewrite signature Optional ==> Optional2 Let's rewrite these: -```ucm -.> rewrite rule1 +``` ucm +scratch/main> rewrite rule1 ☝️ @@ -39,7 +38,7 @@ Let's rewrite these: The rewritten file has been added to the top of scratch.u -.> rewrite eitherToOptional +scratch/main> rewrite eitherToOptional ☝️ @@ -49,7 +48,7 @@ Let's rewrite these: The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): ex1 @@ -79,7 +78,7 @@ type Optional2 a = Some2 a | None2 rule2 x = @rewrite signature Optional ==> Optional2 ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): Either.mapRight @@ -111,8 +110,8 @@ rule2 x = @rewrite signature Optional ==> Optional2 After adding to the codebase, here's the rewritten source: -```ucm -.> view ex1 Either.mapRight rule1 +``` ucm +scratch/main> view ex1 Either.mapRight rule1 Either.mapRight : (a ->{g} b) -> Optional a ->{g} Optional b Either.mapRight f = cases @@ -137,7 +136,7 @@ After adding to the codebase, here's the rewritten source: ``` Another example, showing that we can rewrite to definitions that only exist in the file: -```unison +``` unison unique ability Woot1 where woot1 : () -> Nat unique ability Woot2 where woot2 : () -> Nat @@ -157,8 +156,8 @@ blah2 = 456 Let's apply the rewrite `woot1to2`: -```ucm -.> rewrite woot1to2 +``` ucm +scratch/main> rewrite woot1to2 ☝️ @@ -167,7 +166,7 @@ Let's apply the rewrite `woot1to2`: The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): wootEx @@ -183,7 +182,7 @@ woot1to2 x = wootEx : Nat ->{Woot2} Nat wootEx a = - _ = !Woot2.woot2 + _ = Woot2.woot2() blah2 blah = 123 @@ -193,18 +192,18 @@ blah2 = 456 After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`: -```ucm -.> view wootEx +``` ucm +scratch/main> view wootEx wootEx : Nat ->{Woot2} Nat wootEx a = - _ = !woot2 + _ = woot2() blah2 ``` This example shows that rewrite rules can to refer to term definitions that only exist in the file: -```unison +``` unison foo1 = b = "b" 123 @@ -225,8 +224,8 @@ sameFileEx = After adding the rewritten form to the codebase, here's the rewritten definitions: -```ucm -.> view foo1 foo2 sameFileEx +``` ucm +scratch/main> view foo1 foo2 sameFileEx foo1 : Nat foo1 = @@ -246,7 +245,7 @@ After adding the rewritten form to the codebase, here's the rewritten definition ``` ## Capture avoidance -```unison +``` unison bar1 = b = "bar" 123 @@ -266,8 +265,8 @@ sameFileEx = In the above example, `bar2` is locally bound by the rule, so when applied, it should not refer to the `bar2` top level binding. -```ucm -.> rewrite rule +``` ucm +scratch/main> rewrite rule ☝️ @@ -276,7 +275,7 @@ In the above example, `bar2` is locally bound by the rule, so when applied, it s The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): sameFileEx @@ -300,8 +299,8 @@ sameFileEx = Instead, it should be an unbound free variable, which doesn't typecheck: -```ucm -.> load +``` ucm +scratch/main> load Loading changes detected in scratch.u. @@ -321,7 +320,7 @@ Instead, it should be an unbound free variable, which doesn't typecheck: ``` In this example, the `a` is locally bound by the rule, so it shouldn't capture the `a = 39494` binding which is in scope at the point of the replacement: -```unison +``` unison bar2 = a = 39494 233 @@ -331,8 +330,8 @@ rule a = @rewrite term 233 ==> a ``` -```ucm -.> rewrite rule +``` ucm +scratch/main> rewrite rule ☝️ @@ -341,7 +340,7 @@ rule a = @rewrite The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): bar2 @@ -357,8 +356,8 @@ rule a = The `a` introduced will be freshened to not capture the `a` in scope, so it remains as an unbound variable and is a type error: -```ucm -.> load +``` ucm +scratch/main> load Loading changes detected in scratch.u. @@ -378,17 +377,17 @@ The `a` introduced will be freshened to not capture the `a` in scope, so it rema ``` ## Structural find -```unison +``` unison eitherEx = Left ("hello", "there") ``` -```unison +``` unison findEitherEx x = @rewrite term Left ("hello", x) ==> Left ("hello" Text.++ x) findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` -```ucm -.> sfind findEitherEx +``` ucm +scratch/main> sfind findEitherEx 🔎 @@ -398,7 +397,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () Tip: Try `edit 1` to bring this into your scratch file. -.> sfind findEitherFailure +scratch/main> sfind findEitherFailure 🔎 @@ -413,7 +412,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () Tip: Try `edit 1` or `edit 1-5` to bring these into your scratch file. -.> find 1-5 +scratch/main> find 1-5 1. Exception.catch : '{g, Exception} a ->{g} Either Failure a 2. Exception.reraise : Either Failure a ->{Exception} a diff --git a/unison-src/transcripts-manual/scheme.md b/unison-src/transcripts-manual/scheme.md index 1c1427280f..35aae31b26 100644 --- a/unison-src/transcripts-manual/scheme.md +++ b/unison-src/transcripts-manual/scheme.md @@ -2,8 +2,8 @@ This transcript executes very slowly, because the compiler has an entire copy of base (and other stuff) within it. ```ucm:hide -.> builtins.merge -.> pull.without-history unison.public.base.trunk base +scratch/main> builtins.merge +scratch/main> pull.without-history unison.public.base.trunk base ``` ```unison @@ -55,7 +55,7 @@ multiAddUp = repeat 35 '(printAddUp 3000000) ``` ```ucm -.> add -.> run singleAddUp -.> run.native multiAddUp +scratch/main> add +scratch/main> run singleAddUp +scratch/main> run.native multiAddUp ``` diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index 7287a7ddba..a7d7b01f3e 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -1,14 +1,14 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio lib.builtins +scratch/a1> builtins.mergeio lib.builtins +scratch/a2> builtins.mergeio lib.builtins ``` ```ucm:hide -.> copy.namespace builtin a1.lib.builtin -.> copy.namespace builtin a2.lib.builtin -.> load unison-src/transcripts-round-trip/reparses-with-same-hash.u -.a1> add +scratch/a1> load unison-src/transcripts-round-trip/reparses-with-same-hash.u +scratch/a1> add ``` ```unison @@ -16,45 +16,40 @@ x = () ``` ```ucm:hide -.a1> find +scratch/a1> find ``` So we can see the pretty-printed output: ```ucm -.a1> edit 1-1000 +scratch/a1> edit 1-1000 ``` ```ucm:hide -.a1> delete.namespace.force lib.builtin +scratch/a1> delete.namespace.force lib.builtins ``` ```ucm:hide -.a2> load +scratch/a2> load ``` ```ucm:hide -.a2> add -.a2> delete.namespace.force lib.builtin +scratch/a2> add +scratch/a2> delete.namespace.force lib.builtins ``` This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. ```ucm:error -.> diff.namespace a1 a2 -``` - -```ucm:hide -.> undo -.> undo +scratch/main> diff.namespace /a1: /a2: ``` Now check that definitions in 'reparses.u' at least parse on round trip: ```ucm:hide -.a3> copy.namespace .builtin lib.builtin -.a3> load unison-src/transcripts-round-trip/reparses.u -.a3> add +scratch/a3> builtins.mergeio lib.builtins +scratch/a3> load unison-src/transcripts-round-trip/reparses.u +scratch/a3> add ``` This just makes 'roundtrip.u' the latest scratch file. @@ -64,37 +59,35 @@ x = () ``` ```ucm:hide -.a3> find +scratch/a3> find ``` ```ucm -.a3> edit 1-5000 +scratch/a3> edit 1-5000 ``` ```ucm:hide -.> move.namespace a3 a3_old -.a3> copy.namespace .builtin lib.builtin -.a3> load -.a3> add -.a3> delete.namespace.force lib.builtin -.a3_old> delete.namespace.force lib.builtin +scratch/a3_new> builtins.mergeio lib.builtins +scratch/a3_new> load +scratch/a3_new> add +scratch/a3> delete.namespace.force lib.builtins +scratch/a3_new> delete.namespace.force lib.builtins ``` These are currently all expected to have different hashes on round trip. ```ucm -.> diff.namespace a3 a3_old +scratch/main> diff.namespace /a3_new: /a3: ``` ## Other regression tests not covered by above -### Comment out builtins in the edit command +### Builtins should appear commented out in the edit command Regression test for https://github.com/unisonweb/unison/pull/3548 -```ucm:hide -.> alias.term ##Nat.+ plus -.> edit plus -.> load -.> undo +```ucm +scratch/regressions> alias.term ##Nat.+ plus +scratch/regressions> edit plus +scratch/regressions> load ``` diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index fdeb756531..def5266331 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -1,10 +1,10 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. -```unison +``` unison x = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,18 +19,18 @@ x = () ``` So we can see the pretty-printed output: -```ucm -.a1> edit 1-1000 +``` ucm +scratch/a1> edit 1-1000 ☝️ - I added 105 definitions to the top of scratch.u + I added 110 definitions to the top of scratch.u You can edit them there, then run `update` to replace the definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +````` unison:added-by-ucm scratch.u structural ability Abort where abort : {Abort} a structural ability Ask a where ask : {Ask a} a @@ -73,13 +73,13 @@ structural ability Zoink where Abort.toDefault! : a -> '{g, Abort} a ->{g} a Abort.toDefault! default thunk = h x = Abort.toDefault! (handler_1778 default x) thunk - handle !thunk with h + handle thunk() with h Abort.toOptional : '{g, Abort} a -> '{g} Optional a Abort.toOptional thunk = do toOptional! thunk Abort.toOptional! : '{g, Abort} a ->{g} Optional a -Abort.toOptional! thunk = toDefault! None do Some !thunk +Abort.toOptional! thunk = toDefault! None do Some thunk() catchAll : x -> Nat catchAll x = 99 @@ -87,7 +87,7 @@ catchAll x = 99 Decode.remainder : '{Ask (Optional Bytes)} Bytes Decode.remainder = do match ask with None -> Bytes.empty - Some b -> b Bytes.++ !Decode.remainder + Some b -> b Bytes.++ Decode.remainder() ex1 : Nat ex1 = @@ -168,7 +168,7 @@ fix_2271 = # Full doc body indented ``` raw - myVal1 = 42 + myVal1 = 42 myVal2 = 43 myVal4 = 44 ``` @@ -194,7 +194,7 @@ fix_2650 = use Nat + y = 12 13 + y - !addNumbers + addNumbers() fix_2650a : tvar -> fun -> () fix_2650a tvar fun = () @@ -331,6 +331,85 @@ fix_4384e = }} }} +fix_4727 : Doc2 +fix_4727 = {{ `` 0xs900dc0ffee `` }} + +fix_4729a : Doc2 +fix_4729a = + {{ + # H1A + + ## H2A + + ``` + {{ + # H1B + + ## B2B + + + }} + ``` + + ## H2A + + + }} + +fix_4729b : Doc2 +fix_4729b = + {{ + # H1A + + ## H2A + + {{ docTable + [[{{ + # HA + + + }}, {{ + # HB + + + }}], [{{ + # a + + + }}, {{ + # b + + + }}]] }} + + ## H2A + + + }} + +fix_4729c : Doc2 +fix_4729c = + {{ + # Examples `` + docCallout + (Some + (syntax.docUntitledSection + [syntax.docSection (syntax.docParagraph [syntax.docWord "Title"]) []])) + (syntax.docUntitledSection + [ syntax.docParagraph + [ syntax.docWord "This" + , syntax.docWord "is" + , syntax.docWord "a" + , syntax.docWord "callout" + , syntax.docWord "with" + , syntax.docWord "a" + , syntax.docWord "title" + ] + ]) `` + + + }} + Fix_525.bar.quaffle : Nat Fix_525.bar.quaffle = 32 @@ -342,6 +421,16 @@ fix_525_exampleTerm quaffle = fix_525_exampleType : Id qualifiedName -> Id Fully.qualifiedName fix_525_exampleType z = Id (Dontcare () 19) +fnApplicationSyntax : Nat +fnApplicationSyntax = + use Nat + + Environment.default = do 1 + 1 + oog = do 2 + 2 + blah : Nat -> Float -> Nat + blah x y = x + 1 + _ = blah Environment.default() 1.0 + blah oog() (max 1.0 2.0) + Foo.bar.qux1 : Nat Foo.bar.qux1 = 42 @@ -672,17 +761,17 @@ UUID.random = do UUID 0 (0, 0) UUID.randomUUIDBytes : 'Bytes UUID.randomUUIDBytes = do - (UUID a (b, _)) = !random + (UUID a (b, _)) = random() encodeNat64be a Bytes.++ encodeNat64be b (|>) : a -> (a ->{e} b) ->{e} b a |> f = f a -``` +````` This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. -```ucm -.> diff.namespace a1 a2 +``` ucm +scratch/main> diff.namespace /a1: /a2: The namespaces are identical. @@ -691,12 +780,12 @@ Now check that definitions in 'reparses.u' at least parse on round trip: This just makes 'roundtrip.u' the latest scratch file. -```unison +``` unison x = () ``` -```ucm -.a3> edit 1-5000 +``` ucm +scratch/a3> edit 1-5000 ☝️ @@ -706,7 +795,7 @@ x = () definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +```` unison:added-by-ucm scratch.u explanationOfThisFile : Text explanationOfThisFile = """ @@ -726,12 +815,12 @@ sloppyDocEval = 1 + 1 ``` }} -``` +```` These are currently all expected to have different hashes on round trip. -```ucm -.> diff.namespace a3 a3_old +``` ucm +scratch/main> diff.namespace /a3_new: /a3: Updates: @@ -742,7 +831,32 @@ These are currently all expected to have different hashes on round trip. ``` ## Other regression tests not covered by above -### Comment out builtins in the edit command +### Builtins should appear commented out in the edit command Regression test for https://github.com/unisonweb/unison/pull/3548 +``` ucm +scratch/regressions> alias.term ##Nat.+ plus + + Done. + +scratch/regressions> edit plus + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/regressions> load + + Loading changes detected in scratch.u. + + I loaded scratch.u and didn't find anything. + +``` +``` unison:added-by-ucm scratch.u +-- builtin plus : ##Nat -> ##Nat -> ##Nat +``` + diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 09b941ff64..98fbe28a57 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -1,5 +1,5 @@ --- A very simple example to start +-- A very simple example to start simplestPossibleExample = 1 + 1 -- Destructuring binds @@ -73,7 +73,7 @@ Abort.toDefault! default thunk = h x = Abort.toDefault! (handler_1778 default x) thunk handle (thunk ()) with h -fix_1778 = +fix_1778 = '(let abort 0) |> Abort.toOptional @@ -91,19 +91,19 @@ fix_1536 = 'let fix_2271 : Doc2 fix_2271 = {{ # Full doc body indented - + ``` raw - myVal1 = 42 + myVal1 = 42 myVal2 = 43 myVal4 = 44 ``` - + ``` raw indented1= "hi" indented2="this is two indents" ``` - - I am two spaces over + + I am two spaces over }} @@ -156,7 +156,7 @@ fix_525_exampleTerm quaffle = Fix_525.bar.quaffle + 1 -- This demonstrates the same thing for types. -- exampleType's signature locally binds the 'qualifiedName' type parameter, --- so the pretty-printer should use the longer name 'Fully.qualifiedName' +-- so the pretty-printer should use the longer name 'Fully.qualifiedName' structural type Fully.qualifiedName = Dontcare () Nat structural type Id a = Id a @@ -166,10 +166,10 @@ fix_525_exampleType z = Id (Dontcare () 19) -- We'd get a type error if `exampleTerm` or `exampleType` didn't round-trip, but it typechecks okay! --- Use clauses can't introduce shadowing +-- Use clauses can't introduce shadowing use_clauses_example : Int -> Text -> Nat -use_clauses_example oo quaffle = +use_clauses_example oo quaffle = Fix_525.bar.quaffle + Fix_525.bar.quaffle + 1 use_clauses_example2 : Int -> Nat @@ -193,29 +193,29 @@ Foo'.bar.qux2 = "45" Foo.bar.qux3 = 46 Foo'.bar.qux3 = "47" -ex1 = +ex1 = a = Foo.bar.qux3 + Foo.bar.qux3 Foo.bar.qux1 + Foo.bar.qux1 + Foo.bar.qux2 -ex2 = - a = +ex2 = + a = -- use Foo.bar qux3 will get pushed in here since it's already a multiline block z = 203993 Foo.bar.qux3 + Foo.bar.qux3 Foo.bar.qux1 + Foo.bar.qux1 + Foo.bar.qux2 -ex3 = +ex3 = a = do -- use clause gets pushed in here x = Foo.bar.qux3 + Foo.bar.qux3 x + x () -ex3a = +ex3a = a = do Foo.bar.qux3 + Foo.bar.qux3 -- use clause will get pulled up to top level () --- Make sure use clauses don't show up before a soft hang +-- Make sure use clauses don't show up before a soft hang -- Regression test for https://github.com/unisonweb/unison/issues/3883 structural type UUID = UUID Nat (Nat, Nat) @@ -249,7 +249,7 @@ raw_d = """ """ --- Fix for wonky treatment of abilities with multi-segment constructor names +-- Fix for wonky treatment of abilities with multi-segment constructor names -- Regression test for https://github.com/unisonweb/unison/issues/3239 structural ability Zoink where @@ -387,14 +387,14 @@ softhang21a = handle { a } -> "lskdfjlaksjdf al;ksdjf;lkj sa;sldkfja;sldfkj a;lsdkfj asd;lfkj " { Abort.abort -> _ } -> "lskdfjlaksjdf al;ksdjf;lkj sa;sldkfja;sldfkj a;lsdkfj asd;lfkj " -softhang2 x f = 0 +softhang2 x f = 0 softhang22 = softhang2 [0,1,2,3,4,5] cases 0 -> 0 1 -> 1 n -> n + 100 -catchAll x = +catchAll x = 99 softhang23 = do @@ -416,13 +416,13 @@ softhang26 = softhang2 [1,2,3,4] cases 0 -> 1 n -> n + 1 -forkAt loc c = +forkAt loc c = x = 99 - 390439034 + 390439034 softhang27 somewhere = forkAt somewhere do x = 1 - y = 2 + y = 2 x + y softhang28 = softhang2 [0,1,2,3,4,5] cases @@ -432,13 +432,13 @@ softhang28 = softhang2 [0,1,2,3,4,5] cases -- Weirdness reported by Stew with super long lines -longlines x = +longlines x = u = 92393 x longlines_helper x = do x -longlines1 = do +longlines1 = do longlines !(longlines_helper "This has to laksdjf alsdkfj alskdjf asdf be a long enough string to force a line break") longlines2 = @@ -456,7 +456,7 @@ test3 = do -- Regression test for https://github.com/unisonweb/unison/issues/4239 -- `n` was replaced by `error` but should not be. Instead, render as if --- a second param, _, had been provided in the definition. +-- a second param, _, had been provided in the definition. (>>>>) : Nat -> Nat -> () (>>>>) n = cases _ -> bug "" @@ -472,11 +472,11 @@ fix_4352 = {{``+1``}} -- regression test to make sure we don't use soft hang between a `do` and `match` -- if there's imports that have been inserted there -structural ability Ask a where - ask : a +structural ability Ask a where + ask : a Decode.remainder : '{Ask (Optional Bytes)} Bytes -Decode.remainder = do +Decode.remainder = do use Bytes ++ match ask with None -> Bytes.empty @@ -488,7 +488,7 @@ fix_4340 = HandlerWebSocket cases 1 -> "hi sdflkj sdlfkjsdflkj sldfkj sldkfj sdf asdlkfjs dlfkj sldfkj sdf" _ -> abort -fix_4258 x y z = +fix_4258 x y z = _ = "fix_4258" () @@ -497,26 +497,26 @@ fix_4258_example = fix_4258 1 () 2 -- previously, lexer was emitting virtual semicolons inside parens, which -- led to some very odd parse errors in cases like these -stew_issue = +stew_issue = error x = () (++) a b = 0 toText a = a Debug : a -> b -> () Debug a b = () error - (Debug None '(Debug "Failed " -- virtual semicolon here was tripping up parser + (Debug None '(Debug "Failed " -- virtual semicolon here was tripping up parser 42)) -stew_issue2 = +stew_issue2 = error x = () (++) a b = 0 toText a = a Debug : a -> b -> () Debug a b = () error - (Debug None '("Failed " ++ + (Debug None '("Failed " ++ toText 42)) -stew_issue3 = +stew_issue3 = id x = x error x = () (++) a b = 0 @@ -525,7 +525,7 @@ stew_issue3 = configPath = 0 Debug a b = () error - (Debug None '("Failed to get timestamp of config file " ++ + (Debug None '("Failed to get timestamp of config file " ++ toText configPath)) fix_4384 = {{ {{ docExampleBlock 0 do 2 }} }} @@ -539,7 +539,58 @@ fix_4384c = {{ {{ docExampleBlock 0 do fix_4384d = {{ {{ docExampleBlock 0 '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18] }} }} -fix_4384e = +fix_4384e = id : x -> x id x = x - {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} \ No newline at end of file + {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} + +fnApplicationSyntax = + Environment.default = do 1 + 1 + oog = do 2 + 2 + blah : Nat -> Float -> Nat + blah x y = x + 1 + _ = blah Environment.default() 1.0 + blah oog() (Float.max 1.0 2.0) + +fix_4727 = {{ `` 0xs900dc0ffee `` }} + +fix_4729a = {{ + # H1A + + ## H2A + + ``` + {{ + # H1B + + ## B2B + }} + ``` + + ## H2A +}} + +fix_4729b = {{ + # H1A + + ## H2A + + {{ docTable [ + [ {{ # HA }}, {{ # HB }} ], + [ {{ ## a }}, {{ ## b }} ] + ] }} + + ## H2A +}} + +fix_4729c = {{ + # Examples + ``` + docCallout + (Some + {{ + # Title + + }}) {{ This is a callout with a title }} + ``` +}} diff --git a/unison-src/transcripts-using-base/_base.md b/unison-src/transcripts-using-base/_base.md index 1befbcb2e9..8c4d8c707c 100644 --- a/unison-src/transcripts-using-base/_base.md +++ b/unison-src/transcripts-using-base/_base.md @@ -10,9 +10,9 @@ transcripts which contain less boilerplate. ## Usage ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` The test shows that `hex (fromHex str) == str` as expected. @@ -24,7 +24,7 @@ test> hex.tests.ex1 = checks let ``` ```ucm:hide -.> test +scratch/main> test ``` Lets do some basic testing of our test harness to make sure its @@ -50,6 +50,6 @@ testAutoClean _ = ``` ```ucm -.> add -.> io.test testAutoClean +scratch/main> add +scratch/main> io.test testAutoClean ``` diff --git a/unison-src/transcripts-using-base/_base.output.md b/unison-src/transcripts-using-base/_base.output.md index eeaebe564c..eaad4fb38e 100644 --- a/unison-src/transcripts-using-base/_base.output.md +++ b/unison-src/transcripts-using-base/_base.output.md @@ -11,7 +11,7 @@ transcripts which contain less boilerplate. The test shows that `hex (fromHex str) == str` as expected. -```unison +``` unison test> hex.tests.ex1 = checks let s = "3984af9b" [hex (fromHex s) == s] @@ -20,7 +20,7 @@ test> hex.tests.ex1 = checks let Lets do some basic testing of our test harness to make sure its working. -```unison +``` unison testAutoClean : '{io2.IO}[Result] testAutoClean _ = go: '{Stream Result, Exception, io2.IO, TempDirs} Text @@ -39,7 +39,7 @@ testAutoClean _ = Left (Failure _ t _) -> results :+ (Fail t) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -52,22 +52,22 @@ testAutoClean _ = testAutoClean : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testAutoClean : '{IO} [Result] -.> io.test testAutoClean +scratch/main> io.test testAutoClean New test results: - ◉ testAutoClean our temporary directory should exist - ◉ testAutoClean our temporary directory should no longer exist + 1. testAutoClean ◉ our temporary directory should exist + ◉ our temporary directory should no longer exist ✅ 2 test(s) passing - Tip: Use view testAutoClean to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/all-base-hashes.md b/unison-src/transcripts-using-base/all-base-hashes.md index d7050cb774..bb0f27c2cd 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.md +++ b/unison-src/transcripts-using-base/all-base-hashes.md @@ -1,5 +1,5 @@ This transcript is intended to make visible accidental changes to the hashing algorithm. ```ucm -.> find.verbose +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts-using-base/all-base-hashes.output.md b/unison-src/transcripts-using-base/all-base-hashes.output.md index 63c258e137..0b656ef0c3 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.output.md +++ b/unison-src/transcripts-using-base/all-base-hashes.output.md @@ -1,7 +1,7 @@ This transcript is intended to make visible accidental changes to the hashing algorithm. -```ucm -.> find.verbose +``` ucm +scratch/main> find.verbose 1. -- #sgesq8035ut22q779pl1g4gqsg8c81894jjonmrq1bjltphkath225up841hk8dku59tnnc4laj9nggbofamgei4klof0ldc20uj2oo <| : (i ->{g} o) -> i ->{g} o diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.md b/unison-src/transcripts-using-base/binary-encoding-nats.md index 711bcb3300..2eee6caf58 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.md @@ -54,6 +54,6 @@ testABunchOfNats _ = ``` ```ucm -.> add -.> io.test testABunchOfNats +scratch/main> add +scratch/main> io.test testABunchOfNats ``` diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.output.md b/unison-src/transcripts-using-base/binary-encoding-nats.output.md index 0227ff8e25..da9bc7a95a 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.output.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type EncDec = EncDec Text (Nat -> Bytes) (Bytes -> Optional (Nat, Bytes)) BE64 = EncDec "64 bit Big Endian" encodeNat64be decodeNat64be @@ -53,7 +53,7 @@ testABunchOfNats _ = (runTest (testNat 0)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -75,8 +75,8 @@ testABunchOfNats _ = testRoundTrip : Nat -> EncDec ->{IO, Stream Result} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -91,81 +91,81 @@ testABunchOfNats _ = testNat : Nat -> '{IO, Stream Result} () testRoundTrip : Nat -> EncDec ->{IO, Stream Result} () -.> io.test testABunchOfNats +scratch/main> io.test testABunchOfNats New test results: - ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 16 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 16 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 16 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 16 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 16 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 16 bit Little Endian - ◉ testABunchOfNats consumed all input + 1. testABunchOfNats ◉ successfully decoded 4294967295 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4294967295 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 4294967295 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4294967295 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 16 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 16 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 65 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 65 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 65 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 65 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 65 using 16 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 65 using 16 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 0 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 0 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 0 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 0 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 0 using 16 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 0 using 16 bit Little Endian + ◉ consumed all input ✅ 68 test(s) passing - Tip: Use view testABunchOfNats to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/codeops.md b/unison-src/transcripts-using-base/codeops.md index 4754eb0aaf..1e2797769b 100644 --- a/unison-src/transcripts-using-base/codeops.md +++ b/unison-src/transcripts-using-base/codeops.md @@ -153,7 +153,7 @@ swapped name link = ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -236,9 +236,9 @@ we gain the ability to capture output in a transcript, it can be modified to actual show that the serialization works. ```ucm -.> add -.> io.test tests -.> io.test badLoad +scratch/main> add +scratch/main> io.test tests +scratch/main> io.test badLoad ``` ```unison @@ -278,8 +278,8 @@ codeTests = ``` ```ucm -.> add -.> io.test codeTests +scratch/main> add +scratch/main> io.test codeTests ``` ```unison @@ -309,6 +309,6 @@ vtests _ = ``` ```ucm -.> add -.> io.test vtests +scratch/main> add +scratch/main> io.test vtests ``` diff --git a/unison-src/transcripts-using-base/codeops.output.md b/unison-src/transcripts-using-base/codeops.output.md index 3f76560f4a..6e51f371d1 100644 --- a/unison-src/transcripts-using-base/codeops.output.md +++ b/unison-src/transcripts-using-base/codeops.output.md @@ -1,10 +1,9 @@ - Test for code serialization operations. Define a function, serialize it, then deserialize it back to an actual function. Also ask for its dependencies for display later. -```unison +``` unison save : a -> Bytes save x = Value.serialize (Value.value x) @@ -152,7 +151,7 @@ swapped name link = rejected ("swapped " ++ name) rco ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -199,8 +198,8 @@ swapped name link = ->{Throw Text} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -241,7 +240,7 @@ swapped name link = ->{Throw Text} () ``` -```unison +``` unison structural ability Zap where zap : Three Nat Nat Nat @@ -316,7 +315,7 @@ badLoad _ = Left _ -> [Fail "Exception"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -343,8 +342,8 @@ This simply runs some functions to make sure there isn't a crash. Once we gain the ability to capture output in a transcript, it can be modified to actual show that the serialization works. -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -360,40 +359,40 @@ to actual show that the serialization works. tests : '{IO} [Result] zapper : Three Nat Nat Nat -> Request {Zap} r -> r -.> io.test tests +scratch/main> io.test tests New test results: - ◉ tests (ext f) passed - ◉ tests (ext h) passed - ◉ tests (ident compound) passed - ◉ tests (ident fib10) passed - ◉ tests (ident effect) passed - ◉ tests (ident zero) passed - ◉ tests (ident h) passed - ◉ tests (ident text) passed - ◉ tests (ident int) passed - ◉ tests (ident float) passed - ◉ tests (ident termlink) passed - ◉ tests (ident bool) passed - ◉ tests (ident bytes) passed + 1. tests ◉ (ext f) passed + ◉ (ext h) passed + ◉ (ident compound) passed + ◉ (ident fib10) passed + ◉ (ident effect) passed + ◉ (ident zero) passed + ◉ (ident h) passed + ◉ (ident text) passed + ◉ (ident int) passed + ◉ (ident float) passed + ◉ (ident termlink) passed + ◉ (ident bool) passed + ◉ (ident bytes) passed ✅ 13 test(s) passing - Tip: Use view tests to view the source of a test. + Tip: Use view 1 to view the source of a test. -.> io.test badLoad +scratch/main> io.test badLoad New test results: - ◉ badLoad serialized77 + 1. badLoad ◉ serialized77 ✅ 1 test(s) passing - Tip: Use view badLoad to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison codeTests : '{io2.IO} [Result] codeTests = '[ idempotence "idem f" (termLink f) @@ -429,7 +428,7 @@ codeTests = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -442,54 +441,54 @@ codeTests = codeTests : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: codeTests : '{IO} [Result] -.> io.test codeTests +scratch/main> io.test codeTests New test results: - ◉ codeTests (idem f) passed - ◉ codeTests (idem h) passed - ◉ codeTests (idem rotate) passed - ◉ codeTests (idem zapper) passed - ◉ codeTests (idem showThree) passed - ◉ codeTests (idem concatMap) passed - ◉ codeTests (idem big) passed - ◉ codeTests (idem extensionality) passed - ◉ codeTests (idem identicality) passed - ◉ codeTests (verified f) passed - ◉ codeTests (verified h) passed - ◉ codeTests (verified rotate) passed - ◉ codeTests (verified zapper) passed - ◉ codeTests (verified showThree) passed - ◉ codeTests (verified concatMap) passed - ◉ codeTests (verified big) passed - ◉ codeTests (verified extensionality) passed - ◉ codeTests (verified identicality) passed - ◉ codeTests (verified mutual0) passed - ◉ codeTests (verified mutual1) passed - ◉ codeTests (verified mutual2) passed - ◉ codeTests (rejected missing mutual0) passed - ◉ codeTests (rejected missing mutual1) passed - ◉ codeTests (rejected missing mutual2) passed - ◉ codeTests (rejected swapped zapper) passed - ◉ codeTests (rejected swapped extensionality) passed - ◉ codeTests (rejected swapped identicality) passed - ◉ codeTests (rejected swapped mututal0) passed - ◉ codeTests (rejected swapped mututal1) passed - ◉ codeTests (rejected swapped mututal2) passed + 1. codeTests ◉ (idem f) passed + ◉ (idem h) passed + ◉ (idem rotate) passed + ◉ (idem zapper) passed + ◉ (idem showThree) passed + ◉ (idem concatMap) passed + ◉ (idem big) passed + ◉ (idem extensionality) passed + ◉ (idem identicality) passed + ◉ (verified f) passed + ◉ (verified h) passed + ◉ (verified rotate) passed + ◉ (verified zapper) passed + ◉ (verified showThree) passed + ◉ (verified concatMap) passed + ◉ (verified big) passed + ◉ (verified extensionality) passed + ◉ (verified identicality) passed + ◉ (verified mutual0) passed + ◉ (verified mutual1) passed + ◉ (verified mutual2) passed + ◉ (rejected missing mutual0) passed + ◉ (rejected missing mutual1) passed + ◉ (rejected missing mutual2) passed + ◉ (rejected swapped zapper) passed + ◉ (rejected swapped extensionality) passed + ◉ (rejected swapped identicality) passed + ◉ (rejected swapped mututal0) passed + ◉ (rejected swapped mututal1) passed + ◉ (rejected swapped mututal2) passed ✅ 30 test(s) passing - Tip: Use view codeTests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison validateTest : Link.Term ->{IO} Result validateTest l = match Code.lookup l with None -> Fail "Couldn't look up link" @@ -515,7 +514,7 @@ vtests _ = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -529,29 +528,29 @@ vtests _ = vtests : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: validateTest : Link.Term ->{IO} Result vtests : '{IO} [Result] -.> io.test vtests +scratch/main> io.test vtests New test results: - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated + 1. vtests ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated ✅ 8 test(s) passing - Tip: Use view vtests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/doc.md b/unison-src/transcripts-using-base/doc.md index 461a4f04bb..52973ddb3e 100644 --- a/unison-src/transcripts-using-base/doc.md +++ b/unison-src/transcripts-using-base/doc.md @@ -33,9 +33,9 @@ Notice that an anonymous documentation block `{{ ... }}` before a definition `Im You can preview what docs will look like when rendered to the console using the `display` or `docs` commands: ```ucm -.> display d1 -.> docs ImportantConstant -.> docs DayOfWeek +scratch/main> display d1 +scratch/main> docs ImportantConstant +scratch/main> docs DayOfWeek ``` The `docs ImportantConstant` command will look for `ImportantConstant.doc` in the file or codebase. You can do this instead of explicitly linking docs to definitions. @@ -45,11 +45,11 @@ The `docs ImportantConstant` command will look for `ImportantConstant.doc` in th First, we'll load the `syntax.u` file which has examples of all the syntax: ```ucm -.> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u +scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u ``` ```ucm:hide -.> add +scratch/main> add ``` Now we can review different portions of the guide. @@ -57,25 +57,25 @@ we'll show both the pretty-printed source using `view` and the rendered output using `display`: ```ucm -.> view basicFormatting -.> display basicFormatting -.> view lists -.> display lists -.> view evaluation -.> display evaluation -.> view includingSource -.> display includingSource -.> view nonUnisonCodeBlocks -.> display nonUnisonCodeBlocks -.> view otherElements -.> display otherElements +scratch/main> view basicFormatting +scratch/main> display basicFormatting +scratch/main> view lists +scratch/main> display lists +scratch/main> view evaluation +scratch/main> display evaluation +scratch/main> view includingSource +scratch/main> display includingSource +scratch/main> view nonUnisonCodeBlocks +scratch/main> display nonUnisonCodeBlocks +scratch/main> view otherElements +scratch/main> display otherElements ``` Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way: ```ucm -.> view doc.guide -.> display doc.guide +scratch/main> view doc.guide +scratch/main> display doc.guide ``` 🌻 THE END diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 43edad9881..850929abab 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -2,18 +2,18 @@ Unison documentation is written in Unison and has some neat features: -* The documentation type provides a rich vocabulary of elements that go beyond markdown, including asides, callouts, tooltips, and more. -* Docs may contain Unison code which is parsed and typechecked to ensure validity. No more out of date examples that don't compile or assume a bunch of implicit context! -* Embeded examples are live and can show the results of evaluation. This uses the same evaluation cache as Unison's scratch files, allowing Unison docs to function like well-commented spreadsheets or notebooks. -* Links to other definitions are typechecked to ensure they point to valid definitions. The links are resolved to hashes and won't be broken by name changes or moving definitions around. -* Docs can be included in other docs and you can assemble documentation programmatically, using Unison code. -* There's a powerful textual syntax for all of the above, which we'll introduce next. + - The documentation type provides a rich vocabulary of elements that go beyond markdown, including asides, callouts, tooltips, and more. + - Docs may contain Unison code which is parsed and typechecked to ensure validity. No more out of date examples that don't compile or assume a bunch of implicit context\! + - Embeded examples are live and can show the results of evaluation. This uses the same evaluation cache as Unison's scratch files, allowing Unison docs to function like well-commented spreadsheets or notebooks. + - Links to other definitions are typechecked to ensure they point to valid definitions. The links are resolved to hashes and won't be broken by name changes or moving definitions around. + - Docs can be included in other docs and you can assemble documentation programmatically, using Unison code. + - There's a powerful textual syntax for all of the above, which we'll introduce next. ## Introduction Documentation blocks start with `{{` and end with a matching `}}`. You can introduce doc blocks anywhere you'd use an expression, and you can also have anonymous documentation blocks immediately before a top-level term or type. -```unison +``` unison name = {{Alice}} d1 = {{ Hello there {{name}}! }} @@ -28,7 +28,7 @@ The 7 days of the week, defined as: unique type time.DayOfWeek = Sun | Mon | Tue | Wed | Thu | Fri | Sat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,16 +50,16 @@ Notice that an anonymous documentation block `{{ ... }}` before a definition `Im You can preview what docs will look like when rendered to the console using the `display` or `docs` commands: -```ucm -.> display d1 +``` ucm +scratch/main> display d1 Hello there Alice! -.> docs ImportantConstant +scratch/main> docs ImportantConstant An important constant, equal to `42` -.> docs DayOfWeek +scratch/main> docs DayOfWeek The 7 days of the week, defined as: @@ -72,8 +72,8 @@ The `docs ImportantConstant` command will look for `ImportantConstant.doc` in th First, we'll load the `syntax.u` file which has examples of all the syntax: -```ucm -.> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u +``` ucm +scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u Loading changes detected in ./unison-src/transcripts-using-base/doc.md.files/syntax.u. @@ -99,8 +99,8 @@ Now we can review different portions of the guide. we'll show both the pretty-printed source using `view` and the rendered output using `display`: -```ucm -.> view basicFormatting +``` ucm +scratch/main> view basicFormatting basicFormatting : Doc2 basicFormatting = @@ -130,7 +130,7 @@ and the rendered output using `display`: __Next up:__ {lists} }} -.> display basicFormatting +scratch/main> display basicFormatting # Basic formatting @@ -155,7 +155,7 @@ and the rendered output using `display`: *Next up:* lists -.> view lists +scratch/main> view lists lists : Doc2 lists = @@ -198,7 +198,7 @@ and the rendered output using `display`: 3. Get dressed. }} -.> display lists +scratch/main> display lists # Lists @@ -237,7 +237,7 @@ and the rendered output using `display`: 2. Take shower. 3. Get dressed. -.> view evaluation +scratch/main> view evaluation evaluation : Doc2 evaluation = @@ -272,7 +272,7 @@ and the rendered output using `display`: ``` }} -.> display evaluation +scratch/main> display evaluation # Evaluation @@ -300,7 +300,7 @@ and the rendered output using `display`: cube : Nat -> Nat cube x = x * x * x -.> view includingSource +scratch/main> view includingSource includingSource : Doc2 includingSource = @@ -341,7 +341,7 @@ and the rendered output using `display`: {{ docExample 1 do x -> sqr x }}. }} -.> display includingSource +scratch/main> display includingSource # Including Unison source code @@ -387,7 +387,7 @@ and the rendered output using `display`: application, you can put it in double backticks, like so: `sqr x`. This is equivalent to `sqr x`. -.> view nonUnisonCodeBlocks +scratch/main> view nonUnisonCodeBlocks nonUnisonCodeBlocks : Doc2 nonUnisonCodeBlocks = @@ -420,7 +420,7 @@ and the rendered output using `display`: ``` }} -.> display nonUnisonCodeBlocks +scratch/main> display nonUnisonCodeBlocks # Non-Unison code blocks @@ -449,7 +449,7 @@ and the rendered output using `display`: xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) ``` -.> view otherElements +scratch/main> view otherElements otherElements : Doc2 otherElements = @@ -506,7 +506,7 @@ and the rendered output using `display`: ] }} }} -.> display otherElements +scratch/main> display otherElements There are also asides, callouts, tables, tooltips, and more. These don't currently have special syntax; just use the @@ -548,8 +548,8 @@ and the rendered output using `display`: ``` Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way: -```ucm -.> view doc.guide +``` ucm +scratch/main> view doc.guide doc.guide : Doc2 doc.guide = @@ -569,7 +569,7 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub {{ otherElements }} }} -.> display doc.guide +scratch/main> display doc.guide # Unison computable documentation @@ -769,3 +769,4 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub ``` 🌻 THE END + diff --git a/unison-src/transcripts-using-base/failure-tests.md b/unison-src/transcripts-using-base/failure-tests.md index 049b4fcbb1..5f69a8c2a0 100644 --- a/unison-src/transcripts-using-base/failure-tests.md +++ b/unison-src/transcripts-using-base/failure-tests.md @@ -19,13 +19,13 @@ test2 = do ``` ```ucm -.> add +scratch/main> add ``` ```ucm:error -.> io.test test1 +scratch/main> io.test test1 ``` ```ucm:error -.> io.test test2 +scratch/main> io.test test2 ``` diff --git a/unison-src/transcripts-using-base/failure-tests.output.md b/unison-src/transcripts-using-base/failure-tests.output.md index d59d3d7bc8..0efdd87b38 100644 --- a/unison-src/transcripts-using-base/failure-tests.output.md +++ b/unison-src/transcripts-using-base/failure-tests.output.md @@ -6,7 +6,7 @@ Exception ability directly, and the last is code validation. I don't have an easy way to test the last at the moment, but the other two are tested here. -```unison +``` unison test1 : '{IO, Exception} [Result] test1 = do _ = fromUtf8 0xsee @@ -18,7 +18,7 @@ test2 = do [Ok "test2"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -32,8 +32,8 @@ test2 = do test2 : '{IO, Exception} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -41,8 +41,8 @@ test2 = do test2 : '{IO, Exception} [Result] ``` -```ucm -.> io.test test1 +``` ucm +scratch/main> io.test test1 💔💥 @@ -50,15 +50,15 @@ test2 = do Failure (typeLink IOFailure) - "Cannot decode byte '\\xee': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream" + "Cannot decode byte '\\xee': Data.Text.Encoding: Invalid UTF-8 stream" (Any ()) Stack trace: ##raise ``` -```ucm -.> io.test test2 +``` ucm +scratch/main> io.test test2 💔💥 diff --git a/unison-src/transcripts-using-base/fix2158-1.output.md b/unison-src/transcripts-using-base/fix2158-1.output.md index e8014f284a..9a692bb3de 100644 --- a/unison-src/transcripts-using-base/fix2158-1.output.md +++ b/unison-src/transcripts-using-base/fix2158-1.output.md @@ -1,6 +1,6 @@ This transcript tests an ability check failure regression. -```unison +``` unison structural ability Async t g where fork : '{Async t g, g} a -> t a await : t a -> a @@ -11,7 +11,7 @@ Async.parMap f as = List.map await tasks ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,6 +36,7 @@ some subtyping. However, the ability handling was just processing rows in whatever order they occurred, and during inference it happened that `g` -occurred in the row before `Async t g. Processing the stricter parts +occurred in the row before `Async t g`. Processing the stricter parts first is better, becauase it can solve things more precisely and avoid ambiguities relating to subtyping. + diff --git a/unison-src/transcripts-using-base/fix2297.output.md b/unison-src/transcripts-using-base/fix2297.output.md index 575c5a73af..949cdd89e9 100644 --- a/unison-src/transcripts-using-base/fix2297.output.md +++ b/unison-src/transcripts-using-base/fix2297.output.md @@ -1,7 +1,6 @@ This tests a case where a function was somehow discarding abilities. - -```unison +``` unison structural ability Trivial where trivial : () @@ -25,7 +24,7 @@ wat = handleTrivial testAction -- Somehow this completely forgets about Excepti > handleTrivial testAction ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix2358.md b/unison-src/transcripts-using-base/fix2358.md index 915a350607..1c543349e4 100644 --- a/unison-src/transcripts-using-base/fix2358.md +++ b/unison-src/transcripts-using-base/fix2358.md @@ -10,5 +10,5 @@ timingApp2 _ = ``` ```ucm -.> run timingApp2 +scratch/main> run timingApp2 ``` diff --git a/unison-src/transcripts-using-base/fix2358.output.md b/unison-src/transcripts-using-base/fix2358.output.md index 61a3dd8052..7e71541b74 100644 --- a/unison-src/transcripts-using-base/fix2358.output.md +++ b/unison-src/transcripts-using-base/fix2358.output.md @@ -1,7 +1,6 @@ - Tests a former error due to bad calling conventions on delay.impl -```unison +``` unison timingApp2 : '{IO, Exception} () timingApp2 _ = printLine "Hello" @@ -9,7 +8,7 @@ timingApp2 _ = printLine "World" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,8 +21,8 @@ timingApp2 _ = timingApp2 : '{IO, Exception} () ``` -```ucm -.> run timingApp2 +``` ucm +scratch/main> run timingApp2 () diff --git a/unison-src/transcripts-using-base/fix3166.output.md b/unison-src/transcripts-using-base/fix3166.output.md index 4787e17672..9e33e14563 100644 --- a/unison-src/transcripts-using-base/fix3166.output.md +++ b/unison-src/transcripts-using-base/fix3166.output.md @@ -1,7 +1,7 @@ This file tests some obscure issues involved with abilities and over-applied functions. -```unison +``` unison Stream.fromList : [a] -> '{Stream a} () Stream.fromList l _ = _ = List.map (x -> emit x) l @@ -31,7 +31,7 @@ increment n = 1 + n Stream.toList s2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -62,7 +62,7 @@ increment n = 1 + n [100, 200, 300, 400] ``` -```unison +``` unison structural ability E where eff : () -> () @@ -82,7 +82,7 @@ foo _ = > h foo 337 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -105,7 +105,7 @@ foo _ = 7 ``` -```unison +``` unison structural ability Over where over : Nat ->{Over} (Nat -> Nat) @@ -126,7 +126,7 @@ hmm = > hmm ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix3542.output.md b/unison-src/transcripts-using-base/fix3542.output.md index e2d1e7c6a9..976f1c0636 100644 --- a/unison-src/transcripts-using-base/fix3542.output.md +++ b/unison-src/transcripts-using-base/fix3542.output.md @@ -1,4 +1,4 @@ -```unison +``` unison arrayList v n = do use ImmutableByteArray read8 ma = Scope.bytearrayOf v n @@ -13,7 +13,7 @@ arrayList v n = do > Scope.run '(catch (arrayList 7 8)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix3939.md b/unison-src/transcripts-using-base/fix3939.md index 7ec695e6c7..e9634ee2fc 100644 --- a/unison-src/transcripts-using-base/fix3939.md +++ b/unison-src/transcripts-using-base/fix3939.md @@ -6,7 +6,7 @@ meh = 9 ``` ```ucm -.> add -.> find meh -.> docs 1 +scratch/main> add +scratch/main> find meh +scratch/main> docs 1 ``` diff --git a/unison-src/transcripts-using-base/fix3939.output.md b/unison-src/transcripts-using-base/fix3939.output.md index 99197263c4..9240c712f9 100644 --- a/unison-src/transcripts-using-base/fix3939.output.md +++ b/unison-src/transcripts-using-base/fix3939.output.md @@ -1,11 +1,11 @@ -```unison +``` unison {{ A simple doc. }} meh = 9 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,21 +19,21 @@ meh = 9 meh.doc : Doc2 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: meh : Nat meh.doc : Doc2 -.> find meh +scratch/main> find meh 1. meh : Nat 2. meh.doc : Doc2 -.> docs 1 +scratch/main> docs 1 A simple doc. diff --git a/unison-src/transcripts-using-base/fix4746.output.md b/unison-src/transcripts-using-base/fix4746.output.md index fd158585e3..8887e34743 100644 --- a/unison-src/transcripts-using-base/fix4746.output.md +++ b/unison-src/transcripts-using-base/fix4746.output.md @@ -1,7 +1,7 @@ Test case for a variable capture problem during let floating. The encloser wasn't accounting for variables bound by matches. -```unison +``` unison ability Issue t where one : '{Issue t} () -> {Issue t} () two : '{Issue t} () -> {Issue t} () @@ -35,7 +35,7 @@ run s = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix5129.md b/unison-src/transcripts-using-base/fix5129.md new file mode 100644 index 0000000000..a1e8ad3450 --- /dev/null +++ b/unison-src/transcripts-using-base/fix5129.md @@ -0,0 +1,45 @@ +```ucm:hide +scratch/main> builtins.mergeio lib.builtins +``` + +Checks for some bad type checking behavior. Some ability subtyping was +too lenient when higher-order functions were involved. + +```unison:error +foreach : (a ->{g} ()) -> [a] ->{g} () +foreach f = cases + [] -> () + x +: xs -> + f x + foreach f xs + +forkIt : '{IO} () ->{IO} () +forkIt e = + _ = IO.forkComp e + () + +thunk : '{IO,Exception} () +thunk = do + raise (Failure (typeLink MiscFailure) "thunk" (Any ())) + +go = do + foreach forkIt [thunk] +``` + +This comes from issue #3513 + +```unison:error +(<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c +(<<) f g x = f (g x) + +catchAll.impl : '{IO, Exception} a ->{IO} Either Failure a +catchAll.impl thunk = + handle tryEval do catch thunk + with + cases + { x } -> x + {Exception.raise f -> _} -> Left f + +fancyTryEval : '{g, IO, Exception} a ->{g, IO, Exception} a +fancyTryEval = reraise << catchAll.impl +``` diff --git a/unison-src/transcripts-using-base/fix5129.output.md b/unison-src/transcripts-using-base/fix5129.output.md new file mode 100644 index 0000000000..3d07942a78 --- /dev/null +++ b/unison-src/transcripts-using-base/fix5129.output.md @@ -0,0 +1,73 @@ +Checks for some bad type checking behavior. Some ability subtyping was +too lenient when higher-order functions were involved. + +``` unison +foreach : (a ->{g} ()) -> [a] ->{g} () +foreach f = cases + [] -> () + x +: xs -> + f x + foreach f xs + +forkIt : '{IO} () ->{IO} () +forkIt e = + _ = IO.forkComp e + () + +thunk : '{IO,Exception} () +thunk = do + raise (Failure (typeLink MiscFailure) "thunk" (Any ())) + +go = do + foreach forkIt [thunk] +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found an ability mismatch when checking the application + + 18 | foreach forkIt [thunk] + + + When trying to match [Unit ->{𝕖75, IO, Exception} Unit] with + [Unit ->{IO} Unit] the left hand side contained extra + abilities: {𝕖75, Exception} + + + +``` +This comes from issue \#3513 + +``` unison +(<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c +(<<) f g x = f (g x) + +catchAll.impl : '{IO, Exception} a ->{IO} Either Failure a +catchAll.impl thunk = + handle tryEval do catch thunk + with + cases + { x } -> x + {Exception.raise f -> _} -> Left f + +fancyTryEval : '{g, IO, Exception} a ->{g, IO, Exception} a +fancyTryEval = reraise << catchAll.impl +``` + +``` ucm + + Loading changes detected in scratch.u. + + The expression in red + + needs the abilities: {g76} + but was assumed to only require: {IO, Exception} + + This is likely a result of using an un-annotated function as an argument with concrete abilities. Try adding an annotation to the function definition whose body is red. + + 13 | fancyTryEval = reraise << catchAll.impl + + +``` diff --git a/unison-src/transcripts-using-base/hashing.md b/unison-src/transcripts-using-base/hashing.md index 99f7db2477..f7d6a2bdd8 100644 --- a/unison-src/transcripts-using-base/hashing.md +++ b/unison-src/transcripts-using-base/hashing.md @@ -3,7 +3,7 @@ Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases. ```ucm -.> ls builtin.Bytes +scratch/main> ls builtin.Bytes ``` Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`. @@ -43,7 +43,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex And here's the full API: ```ucm -.> find-in builtin.crypto +scratch/main> find-in builtin.crypto ``` Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime: @@ -189,11 +189,11 @@ test> crypto.hash.numTests = ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> test +scratch/main> test ``` ## HMAC tests @@ -251,9 +251,9 @@ test> md5.tests.ex3 = ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> test +scratch/main> test ``` diff --git a/unison-src/transcripts-using-base/hashing.output.md b/unison-src/transcripts-using-base/hashing.output.md index fee4fa0a27..3bede2577e 100644 --- a/unison-src/transcripts-using-base/hashing.output.md +++ b/unison-src/transcripts-using-base/hashing.output.md @@ -2,8 +2,8 @@ Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases. -```ucm -.> ls builtin.Bytes +``` ucm +scratch/main> ls builtin.Bytes 1. ++ (Bytes -> Bytes -> Bytes) 2. at (Nat -> Bytes -> Optional Nat) @@ -45,7 +45,7 @@ Notice the `fromBase16` and `toBase16` functions. Here's some convenience functi Here's a few usage examples: -```unison +``` unison ex1 = fromHex "2947db" |> crypto.hashBytes Sha3_512 |> hex @@ -74,7 +74,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex > ex5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -119,8 +119,8 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex ``` And here's the full API: -```ucm -.> find-in builtin.crypto +``` ucm +scratch/main> find-in builtin.crypto 1. type CryptoFailure 2. Ed25519.sign.impl : Bytes @@ -155,11 +155,11 @@ And here's the full API: ``` Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime: -```unison +``` unison > hash Sha3_256 (fromHex "3849238492") ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -177,9 +177,9 @@ Note that the universal versions of `hash` and `hmac` are currently unimplemente ``` ## Hashing tests -Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_(hash_function))) for the various hashing algorithms: +Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_\(hash_function\))) for the various hashing algorithms: -```unison +``` unison ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected] test> sha3_512.tests.ex1 = @@ -311,48 +311,47 @@ test> crypto.hash.numTests = checks (List.map t (range 0 20)) ``` -```ucm -.> test +``` ucm +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ blake2b_512.tests.ex1 Passed - ◉ blake2b_512.tests.ex2 Passed - ◉ blake2b_512.tests.ex3 Passed - ◉ blake2s_256.tests.ex1 Passed - ◉ crypto.hash.numTests Passed - ◉ sha1.tests.ex1 Passed - ◉ sha1.tests.ex2 Passed - ◉ sha1.tests.ex3 Passed - ◉ sha1.tests.ex4 Passed - ◉ sha2_256.tests.ex1 Passed - ◉ sha2_256.tests.ex2 Passed - ◉ sha2_256.tests.ex3 Passed - ◉ sha2_256.tests.ex4 Passed - ◉ sha2_512.tests.ex1 Passed - ◉ sha2_512.tests.ex2 Passed - ◉ sha2_512.tests.ex3 Passed - ◉ sha2_512.tests.ex4 Passed - ◉ sha3_256.tests.ex1 Passed - ◉ sha3_256.tests.ex2 Passed - ◉ sha3_256.tests.ex3 Passed - ◉ sha3_256.tests.ex4 Passed - ◉ sha3_512.tests.ex1 Passed - ◉ sha3_512.tests.ex2 Passed - ◉ sha3_512.tests.ex3 Passed - ◉ sha3_512.tests.ex4 Passed + 1. blake2b_512.tests.ex1 ◉ Passed + 2. blake2b_512.tests.ex2 ◉ Passed + 3. blake2b_512.tests.ex3 ◉ Passed + 4. blake2s_256.tests.ex1 ◉ Passed + 5. crypto.hash.numTests ◉ Passed + 6. sha1.tests.ex1 ◉ Passed + 7. sha1.tests.ex2 ◉ Passed + 8. sha1.tests.ex3 ◉ Passed + 9. sha1.tests.ex4 ◉ Passed + 10. sha2_256.tests.ex1 ◉ Passed + 11. sha2_256.tests.ex2 ◉ Passed + 12. sha2_256.tests.ex3 ◉ Passed + 13. sha2_256.tests.ex4 ◉ Passed + 14. sha2_512.tests.ex1 ◉ Passed + 15. sha2_512.tests.ex2 ◉ Passed + 16. sha2_512.tests.ex3 ◉ Passed + 17. sha2_512.tests.ex4 ◉ Passed + 18. sha3_256.tests.ex1 ◉ Passed + 19. sha3_256.tests.ex2 ◉ Passed + 20. sha3_256.tests.ex3 ◉ Passed + 21. sha3_256.tests.ex4 ◉ Passed + 22. sha3_512.tests.ex1 ◉ Passed + 23. sha3_512.tests.ex2 ◉ Passed + 24. sha3_512.tests.ex3 ◉ Passed + 25. sha3_512.tests.ex4 ◉ Passed ✅ 25 test(s) passing - Tip: Use view blake2b_512.tests.ex1 to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` ## HMAC tests These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3). -```unison +``` unison ex' alg secret msg expected = checks [hmacBytes alg (fromHex secret) (ascii msg) == fromHex expected] test> hmac_sha2_256.tests.ex1 = @@ -379,7 +378,7 @@ test> hmac_sha2_512.tests.ex2 = "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -423,7 +422,7 @@ test> hmac_sha2_512.tests.ex2 = Test vectors here pulled from [Wikipedia's writeup](https://en.wikipedia.org/wiki/MD5). -```unison +``` unison ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected] test> md5.tests.ex1 = @@ -442,7 +441,7 @@ test> md5.tests.ex3 = "e4d909c290d0fb1ca068ffaddf22cbd0" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -474,43 +473,42 @@ test> md5.tests.ex3 = ✅ Passed Passed ``` -```ucm -.> test +``` ucm +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ blake2b_512.tests.ex1 Passed - ◉ blake2b_512.tests.ex2 Passed - ◉ blake2b_512.tests.ex3 Passed - ◉ blake2s_256.tests.ex1 Passed - ◉ crypto.hash.numTests Passed - ◉ md5.tests.ex1 Passed - ◉ md5.tests.ex2 Passed - ◉ md5.tests.ex3 Passed - ◉ sha1.tests.ex1 Passed - ◉ sha1.tests.ex2 Passed - ◉ sha1.tests.ex3 Passed - ◉ sha1.tests.ex4 Passed - ◉ sha2_256.tests.ex1 Passed - ◉ sha2_256.tests.ex2 Passed - ◉ sha2_256.tests.ex3 Passed - ◉ sha2_256.tests.ex4 Passed - ◉ sha2_512.tests.ex1 Passed - ◉ sha2_512.tests.ex2 Passed - ◉ sha2_512.tests.ex3 Passed - ◉ sha2_512.tests.ex4 Passed - ◉ sha3_256.tests.ex1 Passed - ◉ sha3_256.tests.ex2 Passed - ◉ sha3_256.tests.ex3 Passed - ◉ sha3_256.tests.ex4 Passed - ◉ sha3_512.tests.ex1 Passed - ◉ sha3_512.tests.ex2 Passed - ◉ sha3_512.tests.ex3 Passed - ◉ sha3_512.tests.ex4 Passed + 1. blake2b_512.tests.ex1 ◉ Passed + 2. blake2b_512.tests.ex2 ◉ Passed + 3. blake2b_512.tests.ex3 ◉ Passed + 4. blake2s_256.tests.ex1 ◉ Passed + 5. crypto.hash.numTests ◉ Passed + 6. md5.tests.ex1 ◉ Passed + 7. md5.tests.ex2 ◉ Passed + 8. md5.tests.ex3 ◉ Passed + 9. sha1.tests.ex1 ◉ Passed + 10. sha1.tests.ex2 ◉ Passed + 11. sha1.tests.ex3 ◉ Passed + 12. sha1.tests.ex4 ◉ Passed + 13. sha2_256.tests.ex1 ◉ Passed + 14. sha2_256.tests.ex2 ◉ Passed + 15. sha2_256.tests.ex3 ◉ Passed + 16. sha2_256.tests.ex4 ◉ Passed + 17. sha2_512.tests.ex1 ◉ Passed + 18. sha2_512.tests.ex2 ◉ Passed + 19. sha2_512.tests.ex3 ◉ Passed + 20. sha2_512.tests.ex4 ◉ Passed + 21. sha3_256.tests.ex1 ◉ Passed + 22. sha3_256.tests.ex2 ◉ Passed + 23. sha3_256.tests.ex3 ◉ Passed + 24. sha3_256.tests.ex4 ◉ Passed + 25. sha3_512.tests.ex1 ◉ Passed + 26. sha3_512.tests.ex2 ◉ Passed + 27. sha3_512.tests.ex3 ◉ Passed + 28. sha3_512.tests.ex4 ◉ Passed ✅ 28 test(s) passing - Tip: Use view blake2b_512.tests.ex1 to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/mvar.md b/unison-src/transcripts-using-base/mvar.md index d2114c2e28..81be1ed79b 100644 --- a/unison-src/transcripts-using-base/mvar.md +++ b/unison-src/transcripts-using-base/mvar.md @@ -51,7 +51,7 @@ testMvars _ = runTest test ``` ```ucm -.> add -.> io.test testMvars +scratch/main> add +scratch/main> io.test testMvars ``` diff --git a/unison-src/transcripts-using-base/mvar.output.md b/unison-src/transcripts-using-base/mvar.output.md index 26cccc7baf..c0bfdac99c 100644 --- a/unison-src/transcripts-using-base/mvar.output.md +++ b/unison-src/transcripts-using-base/mvar.output.md @@ -9,8 +9,7 @@ MVars are the building block on which many other concurrency primitives can be built, such as Futures, Run at most once initializer blocks, Queues, etc. - -```unison +``` unison eitherCk : (a -> Boolean) -> Either e a -> Boolean eitherCk f = cases Left _ -> false @@ -51,7 +50,7 @@ testMvars _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -65,34 +64,34 @@ testMvars _ = testMvars : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: eitherCk : (a ->{g} Boolean) -> Either e a ->{g} Boolean testMvars : '{IO} [Result] -.> io.test testMvars +scratch/main> io.test testMvars New test results: - ◉ testMvars ma should not be empty - ◉ testMvars should read what you sow - ◉ testMvars should reap what you sow - ◉ testMvars ma should be empty - ◉ testMvars swap returns old contents - ◉ testMvars swap returns old contents - ◉ testMvars tryRead should succeed when not empty - ◉ testMvars tryPut should fail when not empty - ◉ testMvars tryTake should succeed when not empty - ◉ testMvars tryTake should not succeed when empty - ◉ testMvars ma2 should be empty - ◉ testMvars tryTake should fail when empty - ◉ testMvars tryRead should fail when empty + 1. testMvars ◉ ma should not be empty + ◉ should read what you sow + ◉ should reap what you sow + ◉ ma should be empty + ◉ swap returns old contents + ◉ swap returns old contents + ◉ tryRead should succeed when not empty + ◉ tryPut should fail when not empty + ◉ tryTake should succeed when not empty + ◉ tryTake should not succeed when empty + ◉ ma2 should be empty + ◉ tryTake should fail when empty + ◉ tryRead should fail when empty ✅ 13 test(s) passing - Tip: Use view testMvars to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/namespace-dependencies.md b/unison-src/transcripts-using-base/namespace-dependencies.md deleted file mode 100644 index d338c05432..0000000000 --- a/unison-src/transcripts-using-base/namespace-dependencies.md +++ /dev/null @@ -1,11 +0,0 @@ -# namespace.dependencies command - -```unison:hide -external.mynat = 1 -mynamespace.dependsOnText = external.mynat Nat.+ 10 -``` - -```ucm -.> add -.mynamespace> namespace.dependencies -``` diff --git a/unison-src/transcripts-using-base/namespace-dependencies.output.md b/unison-src/transcripts-using-base/namespace-dependencies.output.md deleted file mode 100644 index caf4dc52c7..0000000000 --- a/unison-src/transcripts-using-base/namespace-dependencies.output.md +++ /dev/null @@ -1,25 +0,0 @@ -# namespace.dependencies command - -```unison -external.mynat = 1 -mynamespace.dependsOnText = external.mynat Nat.+ 10 -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - external.mynat : Nat - mynamespace.dependsOnText : Nat - -.mynamespace> namespace.dependencies - - External dependency Dependents in .mynamespace - .builtin.Nat 1. dependsOnText - - .builtin.Nat.+ 1. dependsOnText - - .external.mynat 1. dependsOnText - -``` diff --git a/unison-src/transcripts-using-base/nat-coersion.md b/unison-src/transcripts-using-base/nat-coersion.md index 3f77501890..ca5ad40f2a 100644 --- a/unison-src/transcripts-using-base/nat-coersion.md +++ b/unison-src/transcripts-using-base/nat-coersion.md @@ -33,6 +33,6 @@ test = 'let ``` ```ucm -.> add -.> io.test test +scratch/main> add +scratch/main> io.test test ``` diff --git a/unison-src/transcripts-using-base/nat-coersion.output.md b/unison-src/transcripts-using-base/nat-coersion.output.md index 38ab4450f0..14d5c66855 100644 --- a/unison-src/transcripts-using-base/nat-coersion.output.md +++ b/unison-src/transcripts-using-base/nat-coersion.output.md @@ -1,4 +1,4 @@ -```unison +``` unison testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}() testNat n expectInt expectFloat = float = Float.fromRepresentation n @@ -31,7 +31,7 @@ test = 'let runTest testABunchOfNats ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -48,8 +48,8 @@ test = 'let ->{Stream Result} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -59,27 +59,27 @@ test = 'let -> Optional Float ->{Stream Result} () -.> io.test test +scratch/main> io.test test New test results: - ◉ test expected 0.0 got 0.0 - ◉ test round trip though float, expected 0 got 0 - ◉ test expected 0 got 0 - ◉ test round trip though Int, expected 0 got 0 - ◉ test skipped - ◉ test expected 1 got 1 - ◉ test round trip though Int, expected 1 got 1 - ◉ test skipped - ◉ test expected -1 got -1 - ◉ test round trip though Int, expected 18446744073709551615 got 18446744073709551615 - ◉ test expected 1.0000000000000002 got 1.0000000000000002 - ◉ test round trip though float, expected 4607182418800017409 got 4607182418800017409 - ◉ test expected 4607182418800017409 got 4607182418800017409 - ◉ test round trip though Int, expected 4607182418800017409 got 4607182418800017409 + 1. test ◉ expected 0.0 got 0.0 + ◉ round trip though float, expected 0 got 0 + ◉ expected 0 got 0 + ◉ round trip though Int, expected 0 got 0 + ◉ skipped + ◉ expected 1 got 1 + ◉ round trip though Int, expected 1 got 1 + ◉ skipped + ◉ expected -1 got -1 + ◉ round trip though Int, expected 18446744073709551615 got 18446744073709551615 + ◉ expected 1.0000000000000002 got 1.0000000000000002 + ◉ round trip though float, expected 4607182418800017409 got 4607182418800017409 + ◉ expected 4607182418800017409 got 4607182418800017409 + ◉ round trip though Int, expected 4607182418800017409 got 4607182418800017409 ✅ 14 test(s) passing - Tip: Use view test to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/net.md b/unison-src/transcripts-using-base/net.md index b1125f7019..067f9b9a45 100644 --- a/unison-src/transcripts-using-base/net.md +++ b/unison-src/transcripts-using-base/net.md @@ -10,7 +10,7 @@ socketAccept = compose reraise socketAccept.impl ``` ```ucm:hide -.> add +scratch/main> add ``` # Tests for network related builtins @@ -93,8 +93,8 @@ testDefaultPort _ = runTest test ``` ```ucm -.> add -.> io.test testDefaultPort +scratch/main> add +scratch/main> io.test testDefaultPort ``` This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar. @@ -149,6 +149,6 @@ testTcpConnect = 'let ``` ```ucm -.> add -.> io.test testTcpConnect +scratch/main> add +scratch/main> io.test testTcpConnect ``` diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index 572ef0fbff..4ffc0528bc 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -1,4 +1,4 @@ -```unison +``` unison serverSocket = compose2 reraise IO.serverSocket.impl socketPort = compose reraise socketPort.impl listen = compose reraise listen.impl @@ -16,14 +16,13 @@ socketAccept = compose reraise socketAccept.impl This section tests functions in the IO builtin related to binding to TCP server socket, as to be able to accept incoming TCP connections. -```builtin -.io2.IO.serverSocket : Optional Text -> Text ->{io2.IO} Either Failure io2.Socket - +``` + builtin.io2.IO.serverSocket : Optional Text -> Text ->{io2.IO} Either Failure io2.Socket ``` This function takes two parameters, The first is the Hostname. If None is provided, We will attempt to bind to 0.0.0.0 (All ipv4 -addresses). We currently only support IPV4 (we should fix this!) +addresses). We currently only support IPV4 (we should fix this\!) The second is the name of the port to bind to. This can be a decimal representation of a port number between 1-65535. This can be a named port like "ssh" (for port 22) or "kermit" (for port 1649), @@ -31,30 +30,32 @@ This mapping of names to port numbers is maintained by the [nsswitch service](https://en.wikipedia.org/wiki/Name_Service_Switch), typically stored in `/etc/services` and queried with the `getent` tool: - # map number to name - $ getent services 22 - ssh 22/tcp - - # map name to number - $ getent services finger - finger 79/tcp - - # get a list of all known names - $ getent services | head - tcpmux 1/tcp - echo 7/tcp - echo 7/udp - discard 9/tcp sink null - discard 9/udp sink null - systat 11/tcp users - daytime 13/tcp - daytime 13/udp - netstat 15/tcp - qotd 17/tcp quote +``` +# map number to name +$ getent services 22 +ssh 22/tcp + +# map name to number +$ getent services finger +finger 79/tcp + +# get a list of all known names +$ getent services | head +tcpmux 1/tcp +echo 7/tcp +echo 7/udp +discard 9/tcp sink null +discard 9/udp sink null +systat 11/tcp users +daytime 13/tcp +daytime 13/udp +netstat 15/tcp +qotd 17/tcp quote +``` Below shows different examples of how we might specify the server coordinates. -```unison +``` unison testExplicitHost : '{io2.IO} [Result] testExplicitHost _ = test = 'let @@ -91,7 +92,7 @@ testDefaultPort _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -106,8 +107,8 @@ testDefaultPort _ = testExplicitHost : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -115,22 +116,22 @@ testDefaultPort _ = testDefaultPort : '{IO} [Result] testExplicitHost : '{IO} [Result] -.> io.test testDefaultPort +scratch/main> io.test testDefaultPort New test results: - ◉ testDefaultPort successfully created socket - ◉ testDefaultPort port should be > 1024 - ◉ testDefaultPort port should be < 65536 + 1. testDefaultPort ◉ successfully created socket + ◉ port should be > 1024 + ◉ port should be < 65536 ✅ 3 test(s) passing - Tip: Use view testDefaultPort to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar. -```unison +``` unison serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread portVar toSend = 'let go : '{io2.IO, Exception}() @@ -178,7 +179,7 @@ testTcpConnect = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -193,8 +194,8 @@ testTcpConnect = 'let testTcpConnect : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -202,14 +203,14 @@ testTcpConnect = 'let serverThread : MVar Nat -> Text -> '{IO} () testTcpConnect : '{IO} [Result] -.> io.test testTcpConnect +scratch/main> io.test testTcpConnect New test results: - ◉ testTcpConnect should have reaped what we've sown + 1. testTcpConnect ◉ should have reaped what we've sown ✅ 1 test(s) passing - Tip: Use view testTcpConnect to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/random-deserial.md b/unison-src/transcripts-using-base/random-deserial.md index 1a97ca73d7..2c6ff77de5 100644 --- a/unison-src/transcripts-using-base/random-deserial.md +++ b/unison-src/transcripts-using-base/random-deserial.md @@ -56,6 +56,6 @@ serialTests = do ``` ```ucm -.> add -.> io.test serialTests +scratch/main> add +scratch/main> io.test serialTests ``` diff --git a/unison-src/transcripts-using-base/random-deserial.output.md b/unison-src/transcripts-using-base/random-deserial.output.md index 48ff86e187..6c68e978ec 100644 --- a/unison-src/transcripts-using-base/random-deserial.output.md +++ b/unison-src/transcripts-using-base/random-deserial.output.md @@ -1,4 +1,4 @@ -```unison +``` unison directory = "unison-src/transcripts-using-base/serialized-cases/" availableCases : '{IO,Exception} [Text] @@ -55,7 +55,7 @@ serialTests = do List.map snd (bSort (List.map runTestCase cs)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -73,8 +73,8 @@ serialTests = do shuffle : Nat -> [a] -> [a] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -85,18 +85,18 @@ serialTests = do serialTests : '{IO, Exception} [Result] shuffle : Nat -> [a] -> [a] -.> io.test serialTests +scratch/main> io.test serialTests New test results: - ◉ serialTests case-00 - ◉ serialTests case-01 - ◉ serialTests case-02 - ◉ serialTests case-03 - ◉ serialTests case-04 + 1. serialTests ◉ case-00 + ◉ case-01 + ◉ case-02 + ◉ case-03 + ◉ case-04 ✅ 5 test(s) passing - Tip: Use view serialTests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/ref-promise.md b/unison-src/transcripts-using-base/ref-promise.md index dd54328ec5..3c2575951c 100644 --- a/unison-src/transcripts-using-base/ref-promise.md +++ b/unison-src/transcripts-using-base/ref-promise.md @@ -19,8 +19,8 @@ casTest = do ``` ```ucm -.> add -.> io.test casTest +scratch/main> add +scratch/main> io.test casTest ``` Promise is a simple one-shot awaitable condition. @@ -54,9 +54,9 @@ promiseConcurrentTest = do ``` ```ucm -.> add -.> io.test promiseSequentialTest -.> io.test promiseConcurrentTest +scratch/main> add +scratch/main> io.test promiseSequentialTest +scratch/main> io.test promiseConcurrentTest ``` CAS can be used to write an atomic update function. @@ -70,7 +70,7 @@ atomicUpdate ref f = ``` ```ucm -.> add +scratch/main> add ``` Promise can be used to write an operation that spawns N concurrent @@ -91,7 +91,7 @@ spawnN n fa = map Promise.read (go n []) ``` ```ucm -.> add +scratch/main> add ``` We can use these primitives to write a more interesting example, where @@ -123,6 +123,6 @@ fullTest = do ``` ```ucm -.> add -.> io.test fullTest +scratch/main> add +scratch/main> io.test fullTest ``` diff --git a/unison-src/transcripts-using-base/ref-promise.output.md b/unison-src/transcripts-using-base/ref-promise.output.md index 727f62e89e..b44e98bb9f 100644 --- a/unison-src/transcripts-using-base/ref-promise.output.md +++ b/unison-src/transcripts-using-base/ref-promise.output.md @@ -3,7 +3,7 @@ Ref support a CAS operation that can be used as a building block to change state atomically without locks. -```unison +``` unison casTest: '{io2.IO} [Result] casTest = do test = do @@ -18,7 +18,7 @@ casTest = do runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -31,28 +31,28 @@ casTest = do casTest : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: casTest : '{IO} [Result] -.> io.test casTest +scratch/main> io.test casTest New test results: - ◉ casTest CAS is successful is there were no conflicting writes - ◉ casTest CAS fails when there was an intervening write + 1. casTest ◉ CAS is successful is there were no conflicting writes + ◉ CAS fails when there was an intervening write ✅ 2 test(s) passing - Tip: Use view casTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Promise is a simple one-shot awaitable condition. -```unison +``` unison promiseSequentialTest : '{IO} [Result] promiseSequentialTest = do test = do @@ -80,7 +80,7 @@ promiseConcurrentTest = do runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -94,41 +94,39 @@ promiseConcurrentTest = do promiseSequentialTest : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: promiseConcurrentTest : '{IO} [Result] promiseSequentialTest : '{IO} [Result] -.> io.test promiseSequentialTest +scratch/main> io.test promiseSequentialTest New test results: - ◉ promiseSequentialTest Should read a value that's been written - ◉ promiseSequentialTest Promise can only be written to once + 1. promiseSequentialTest ◉ Should read a value that's been written + ◉ Promise can only be written to once ✅ 2 test(s) passing - Tip: Use view promiseSequentialTest to view the source of a - test. + Tip: Use view 1 to view the source of a test. -.> io.test promiseConcurrentTest +scratch/main> io.test promiseConcurrentTest New test results: - ◉ promiseConcurrentTest Reads awaits for completion of the Promise + 1. promiseConcurrentTest ◉ Reads awaits for completion of the Promise ✅ 1 test(s) passing - Tip: Use view promiseConcurrentTest to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` CAS can be used to write an atomic update function. -```unison +``` unison atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () atomicUpdate ref f = ticket = Ref.readForCas ref @@ -136,7 +134,7 @@ atomicUpdate ref f = if Ref.cas ref ticket value then () else atomicUpdate ref f ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -149,8 +147,8 @@ atomicUpdate ref f = atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -160,7 +158,7 @@ atomicUpdate ref f = Promise can be used to write an operation that spawns N concurrent tasks and collects their results -```unison +``` unison spawnN : Nat -> '{IO} a ->{IO} [a] spawnN n fa = use Nat eq drop @@ -175,7 +173,7 @@ spawnN n fa = map Promise.read (go n []) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -188,8 +186,8 @@ spawnN n fa = spawnN : Nat -> '{IO} a ->{IO} [a] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -200,7 +198,7 @@ We can use these primitives to write a more interesting example, where multiple threads repeatedly update an atomic counter, we check that the value of the counter is correct after all threads are done. -```unison +``` unison fullTest : '{IO} [Result] fullTest = do use Nat * + eq drop @@ -224,7 +222,7 @@ fullTest = do runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -237,21 +235,21 @@ fullTest = do fullTest : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: fullTest : '{IO} [Result] -.> io.test fullTest +scratch/main> io.test fullTest New test results: - ◉ fullTest The state of the counter is consistent + 1. fullTest ◉ The state of the counter is consistent ✅ 1 test(s) passing - Tip: Use view fullTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/serial-test-00.md b/unison-src/transcripts-using-base/serial-test-00.md index ab71adfdd4..21860243e3 100644 --- a/unison-src/transcripts-using-base/serial-test-00.md +++ b/unison-src/transcripts-using-base/serial-test-00.md @@ -68,6 +68,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-00.output.md b/unison-src/transcripts-using-base/serial-test-00.output.md index 715680f06b..ce996f93ba 100644 --- a/unison-src/transcripts-using-base/serial-test-00.output.md +++ b/unison-src/transcripts-using-base/serial-test-00.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type Tree a = Leaf | Node (Tree a) a (Tree a) foldMap : r -> (r -> r -> r) -> (a -> r) -> Tree a -> r @@ -67,7 +67,7 @@ mkTestCase = do saveTestCase "case-00" "v4" f tup ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -94,8 +94,8 @@ mkTestCase = do tree3 : Tree Text ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -115,7 +115,7 @@ mkTestCase = do tree2 : Tree Nat tree3 : Tree Text -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-01.md b/unison-src/transcripts-using-base/serial-test-01.md index da25e8f4a4..bc5f84af0d 100644 --- a/unison-src/transcripts-using-base/serial-test-01.md +++ b/unison-src/transcripts-using-base/serial-test-01.md @@ -16,6 +16,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-01.output.md b/unison-src/transcripts-using-base/serial-test-01.output.md index 9194621631..a6654a2547 100644 --- a/unison-src/transcripts-using-base/serial-test-01.output.md +++ b/unison-src/transcripts-using-base/serial-test-01.output.md @@ -1,4 +1,4 @@ -```unison +``` unison l1 = [1.0,2.0,3.0] l2 = [+1,+2,+3] l3 = [?a, ?b, ?c] @@ -15,7 +15,7 @@ mkTestCase = do saveTestCase "case-01" "v4" combines (l1, l2, l3) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -32,8 +32,8 @@ mkTestCase = do mkTestCase : '{IO, Exception} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -43,7 +43,7 @@ mkTestCase = do l3 : [Char] mkTestCase : '{IO, Exception} () -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-02.md b/unison-src/transcripts-using-base/serial-test-02.md index 3d13ee487b..15518165a0 100644 --- a/unison-src/transcripts-using-base/serial-test-02.md +++ b/unison-src/transcripts-using-base/serial-test-02.md @@ -30,6 +30,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-02.output.md b/unison-src/transcripts-using-base/serial-test-02.output.md index a6957230e9..102fea092b 100644 --- a/unison-src/transcripts-using-base/serial-test-02.output.md +++ b/unison-src/transcripts-using-base/serial-test-02.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability Exit a where exit : a -> b @@ -29,7 +29,7 @@ mkTestCase = do ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -48,8 +48,8 @@ mkTestCase = do products : ([Nat], [Nat], [Nat]) -> Text ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -61,7 +61,7 @@ mkTestCase = do prod : [Nat] -> Nat products : ([Nat], [Nat], [Nat]) -> Text -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-03.md b/unison-src/transcripts-using-base/serial-test-03.md index d1f49c4040..2e66f687d9 100644 --- a/unison-src/transcripts-using-base/serial-test-03.md +++ b/unison-src/transcripts-using-base/serial-test-03.md @@ -44,6 +44,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-03.output.md b/unison-src/transcripts-using-base/serial-test-03.output.md index c161d048bd..a20eafe7f6 100644 --- a/unison-src/transcripts-using-base/serial-test-03.output.md +++ b/unison-src/transcripts-using-base/serial-test-03.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability DC r where shift : ((a -> r) -> r) -> a @@ -43,7 +43,7 @@ mkTestCase = do saveTestCase "case-03" "v4" finish trip ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -67,8 +67,8 @@ mkTestCase = do suspSum : [Nat] -> Delayed Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -84,7 +84,7 @@ mkTestCase = do reset : '{DC r} r -> r suspSum : [Nat] -> Delayed Nat -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-04.md b/unison-src/transcripts-using-base/serial-test-04.md index f4763238f6..212b59c9e0 100644 --- a/unison-src/transcripts-using-base/serial-test-04.md +++ b/unison-src/transcripts-using-base/serial-test-04.md @@ -14,6 +14,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-04.output.md b/unison-src/transcripts-using-base/serial-test-04.output.md index ca1949502d..990ce14799 100644 --- a/unison-src/transcripts-using-base/serial-test-04.output.md +++ b/unison-src/transcripts-using-base/serial-test-04.output.md @@ -1,4 +1,4 @@ -```unison +``` unison mutual0 = cases 0 -> "okay" n -> @@ -12,7 +12,7 @@ mkTestCase = do saveTestCase "case-04" "v4" mutual1 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,8 +27,8 @@ mkTestCase = do mutual1 : Nat -> Text ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -36,7 +36,7 @@ mkTestCase = do mutual0 : Nat -> Text mutual1 : Nat -> Text -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/stm.md b/unison-src/transcripts-using-base/stm.md index 0320353161..1a036fd260 100644 --- a/unison-src/transcripts-using-base/stm.md +++ b/unison-src/transcripts-using-base/stm.md @@ -28,7 +28,7 @@ body k out v = ``` ```ucm -.> add +scratch/main> add ``` Test case. @@ -67,6 +67,6 @@ tests = '(map spawn nats) ``` ```ucm -.> add -.> io.test tests +scratch/main> add +scratch/main> io.test tests ``` diff --git a/unison-src/transcripts-using-base/stm.output.md b/unison-src/transcripts-using-base/stm.output.md index a5d87ed520..2e7724f9e3 100644 --- a/unison-src/transcripts-using-base/stm.output.md +++ b/unison-src/transcripts-using-base/stm.output.md @@ -1,6 +1,7 @@ Loops that access a shared counter variable, accessed in transactions. Some thread delaying is just accomplished by counting in a loop. -```unison + +``` unison count : Nat -> () count = cases 0 -> () @@ -27,7 +28,7 @@ body k out v = atomically '(TVar.write out (Some n)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -43,8 +44,8 @@ body k out v = loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -56,7 +57,7 @@ body k out v = ``` Test case. -```unison +``` unison spawn : Nat ->{io2.IO} Result spawn k = let out1 = TVar.newIO None @@ -89,7 +90,7 @@ tests : '{io2.IO} [Result] tests = '(map spawn nats) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -105,8 +106,8 @@ tests = '(map spawn nats) tests : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -115,23 +116,23 @@ tests = '(map spawn nats) spawn : Nat ->{IO} Result tests : '{IO} [Result] -.> io.test tests +scratch/main> io.test tests New test results: - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified + 1. tests ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified ✅ 10 test(s) passing - Tip: Use view tests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.md b/unison-src/transcripts-using-base/test-watch-dependencies.md index 8f3c610561..3e7558da3e 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.md @@ -9,7 +9,7 @@ x = 999 ``` ```ucm:hide -.> add +scratch/main> add ``` Now, we update that definition and define a test-watch which depends on it. @@ -22,7 +22,7 @@ test> mytest = checks [x + 1 == 1001] We expect this 'add' to fail because the test is blocked by the update to `x`. ```ucm:error -.> add +scratch/main> add ``` --- @@ -35,5 +35,5 @@ test> useY = checks [y + 1 == 43] This should correctly identify `y` as a dependency and add that too. ```ucm -.> add useY +scratch/main> add useY ``` diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.output.md b/unison-src/transcripts-using-base/test-watch-dependencies.output.md index 53835d0f6e..a321643568 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.output.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.output.md @@ -4,18 +4,18 @@ https://github.com/unisonweb/unison/issues/2195 We add a simple definition. -```unison +``` unison x = 999 ``` Now, we update that definition and define a test-watch which depends on it. -```unison +``` unison x = 1000 test> mytest = checks [x + 1 == 1001] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -42,8 +42,8 @@ test> mytest = checks [x + 1 == 1001] ``` We expect this 'add' to fail because the test is blocked by the update to `x`. -```ucm -.> add +``` ucm +scratch/main> add x These definitions failed: @@ -54,14 +54,14 @@ We expect this 'add' to fail because the test is blocked by the update to `x`. Tip: Use `help filestatus` to learn more. ``` ---- +----- -```unison +``` unison y = 42 test> useY = checks [y + 1 == 43] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -84,8 +84,8 @@ test> useY = checks [y + 1 == 43] ``` This should correctly identify `y` as a dependency and add that too. -```ucm -.> add useY +``` ucm +scratch/main> add useY ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/thread.md b/unison-src/transcripts-using-base/thread.md index d2c2712042..9811d192ce 100644 --- a/unison-src/transcripts-using-base/thread.md +++ b/unison-src/transcripts-using-base/thread.md @@ -19,8 +19,8 @@ testBasicFork = 'let See if we can get another thread to stuff a value into a MVar ```ucm:hide -.> add -.> io.test testBasicFork +scratch/main> add +scratch/main> io.test testBasicFork ``` ```unison @@ -48,8 +48,8 @@ testBasicMultiThreadMVar = 'let ``` ```ucm -.> add -.> io.test testBasicMultiThreadMVar +scratch/main> add +scratch/main> io.test testBasicMultiThreadMVar ``` ```unison @@ -91,6 +91,6 @@ testTwoThreads = 'let ``` ```ucm -.> add -.> io.test testTwoThreads +scratch/main> add +scratch/main> io.test testTwoThreads ``` diff --git a/unison-src/transcripts-using-base/thread.output.md b/unison-src/transcripts-using-base/thread.output.md index 76c28fa213..863d749698 100644 --- a/unison-src/transcripts-using-base/thread.output.md +++ b/unison-src/transcripts-using-base/thread.output.md @@ -1,6 +1,6 @@ Lets just make sure we can start a thread -```unison +``` unison otherThread : '{io2.IO}() otherThread = 'let watch "I'm the other Thread" () @@ -16,7 +16,7 @@ testBasicFork = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -32,7 +32,7 @@ testBasicFork = 'let ``` See if we can get another thread to stuff a value into a MVar -```unison +``` unison thread1 : Nat -> MVar Nat -> '{io2.IO}() thread1 x mv = 'let go = 'let @@ -56,7 +56,7 @@ testBasicMultiThreadMVar = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -70,27 +70,26 @@ testBasicMultiThreadMVar = 'let thread1 : Nat -> MVar Nat -> '{IO} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testBasicMultiThreadMVar : '{IO} [Result] thread1 : Nat -> MVar Nat -> '{IO} () -.> io.test testBasicMultiThreadMVar +scratch/main> io.test testBasicMultiThreadMVar New test results: - ◉ testBasicMultiThreadMVar other thread should have incremented + 1. testBasicMultiThreadMVar ◉ other thread should have incremented ✅ 1 test(s) passing - Tip: Use view testBasicMultiThreadMVar to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison sendingThread: Nat -> MVar Nat -> '{io2.IO}() sendingThread toSend mv = 'let go = 'let @@ -128,7 +127,7 @@ testTwoThreads = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -144,8 +143,8 @@ testTwoThreads = 'let testTwoThreads : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -154,14 +153,14 @@ testTwoThreads = 'let (also named thread1) testTwoThreads : '{IO} [Result] -.> io.test testTwoThreads +scratch/main> io.test testTwoThreads New test results: - ◉ testTwoThreads + 1. testTwoThreads ◉ ✅ 1 test(s) passing - Tip: Use view testTwoThreads to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/tls.md b/unison-src/transcripts-using-base/tls.md index 77c66db491..71b473837a 100644 --- a/unison-src/transcripts-using-base/tls.md +++ b/unison-src/transcripts-using-base/tls.md @@ -12,7 +12,7 @@ not_a_cert = "-----BEGIN SCHERMIFICATE-----\n-----END SCHERMIFICATE-----" ``` ```ucm:hide -.> add +scratch/main> add ``` # Using an alternative certificate store @@ -32,8 +32,8 @@ what_should_work _ = this_should_work ++ this_should_not_work ``` ```ucm -.> add -.> io.test what_should_work +scratch/main> add +scratch/main> io.test what_should_work ``` Test handshaking a client/server a local TCP connection using our @@ -191,8 +191,8 @@ testCNReject _ = ``` ```ucm -.> add -.> io.test testConnectSelfSigned -.> io.test testCAReject -.> io.test testCNReject +scratch/main> add +scratch/main> io.test testConnectSelfSigned +scratch/main> io.test testCAReject +scratch/main> io.test testCNReject ``` diff --git a/unison-src/transcripts-using-base/tls.output.md b/unison-src/transcripts-using-base/tls.output.md index 135f490186..76b9be2782 100644 --- a/unison-src/transcripts-using-base/tls.output.md +++ b/unison-src/transcripts-using-base/tls.output.md @@ -1,6 +1,6 @@ # Tests for TLS builtins -```unison +``` unison -- generated with: -- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 3650 -out cert.pem @@ -15,7 +15,7 @@ not_a_cert = "-----BEGIN SCHERMIFICATE-----\n-----END SCHERMIFICATE-----" First lets make sure we can load our cert and private key -```unison +``` unison this_should_work=match (decodeCert.impl (toUtf8 self_signed_cert_pem2) with Left (Failure _ t _) -> [Fail t] Right _ -> [Ok "succesfully decoded self_signed_pem"] @@ -27,7 +27,7 @@ this_should_not_work=match (decodeCert.impl (toUtf8 not_a_cert) with what_should_work _ = this_should_work ++ this_should_not_work ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -42,8 +42,8 @@ what_should_work _ = this_should_work ++ this_should_not_work what_should_work : ∀ _. _ -> [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -51,16 +51,16 @@ what_should_work _ = this_should_work ++ this_should_not_work this_should_work : [Result] what_should_work : ∀ _. _ -> [Result] -.> io.test what_should_work +scratch/main> io.test what_should_work New test results: - ◉ what_should_work succesfully decoded self_signed_pem - ◉ what_should_work failed + 1. what_should_work ◉ succesfully decoded self_signed_pem + ◉ failed ✅ 2 test(s) passing - Tip: Use view what_should_work to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Test handshaking a client/server a local TCP connection using our @@ -71,7 +71,7 @@ We'll create a server and a client, and start threads for each. The server will report the port it is bound to via a passed MVar which the client can read. -```unison +``` unison serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread portVar toSend = 'let go: '{io2.IO, Exception}() @@ -217,7 +217,7 @@ testCNReject _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -237,8 +237,8 @@ testCNReject _ = testConnectSelfSigned : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -251,35 +251,34 @@ testCNReject _ = -> '{IO, Exception} Text testConnectSelfSigned : '{IO} [Result] -.> io.test testConnectSelfSigned +scratch/main> io.test testConnectSelfSigned New test results: - ◉ testConnectSelfSigned should have reaped what we've sown + 1. testConnectSelfSigned ◉ should have reaped what we've sown ✅ 1 test(s) passing - Tip: Use view testConnectSelfSigned to view the source of a - test. + Tip: Use view 1 to view the source of a test. -.> io.test testCAReject +scratch/main> io.test testCAReject New test results: - ◉ testCAReject correctly rejected self-signed cert + 1. testCAReject ◉ correctly rejected self-signed cert ✅ 1 test(s) passing - Tip: Use view testCAReject to view the source of a test. + Tip: Use view 1 to view the source of a test. -.> io.test testCNReject +scratch/main> io.test testCNReject New test results: - ◉ testCNReject correctly rejected self-signed cert + 1. testCNReject ◉ correctly rejected self-signed cert ✅ 1 test(s) passing - Tip: Use view testCNReject to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/utf8.md b/unison-src/transcripts-using-base/utf8.md index 107bd260cd..4bf0586575 100644 --- a/unison-src/transcripts-using-base/utf8.md +++ b/unison-src/transcripts-using-base/utf8.md @@ -3,7 +3,7 @@ Test for new Text -> Bytes conversions explicitly using UTF-8 as the encoding Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text. ```ucm -.> find Utf8 +scratch/main> find Utf8 ``` ascii characters are encoded as single bytes (in the range 0-127). diff --git a/unison-src/transcripts-using-base/utf8.output.md b/unison-src/transcripts-using-base/utf8.output.md index 6bba05281a..f5bf210754 100644 --- a/unison-src/transcripts-using-base/utf8.output.md +++ b/unison-src/transcripts-using-base/utf8.output.md @@ -1,9 +1,9 @@ -Test for new Text -> Bytes conversions explicitly using UTF-8 as the encoding +Test for new Text -\> Bytes conversions explicitly using UTF-8 as the encoding Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text. -```ucm -.> find Utf8 +``` ucm +scratch/main> find Utf8 1. builtin.Text.toUtf8 : Text -> Bytes 2. Text.fromUtf8 : Bytes ->{Exception} Text @@ -13,7 +13,7 @@ Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding o ``` ascii characters are encoded as single bytes (in the range 0-127). -```unison +``` unison ascii: Text ascii = "ABCDE" @@ -21,7 +21,7 @@ ascii = "ABCDE" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,14 +44,14 @@ ascii = "ABCDE" ``` non-ascii characters are encoded as multiple bytes. -```unison +``` unison greek: Text greek = "ΑΒΓΔΕ" > toUtf8 greek ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -73,7 +73,7 @@ greek = "ΑΒΓΔΕ" ``` We can check that encoding and then decoding should give us back the same `Text` we started with -```unison +``` unison checkRoundTrip: Text -> [Result] checkRoundTrip t = bytes = toUtf8 t @@ -86,7 +86,7 @@ greek = "ΑΒΓΔΕ" test> greekTest = checkRoundTrip greek ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -110,7 +110,7 @@ test> greekTest = checkRoundTrip greek ``` If we try to decode an invalid set of bytes, we get back `Text` explaining the decoding error: -```unison +``` unison greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] @@ -121,7 +121,7 @@ greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -138,6 +138,6 @@ greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] 5 | > match fromUtf8.impl (drop 1 greek_bytes) with ⧩ - "Cannot decode byte '\\x91': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream" + "Cannot decode byte '\\x91': Data.Text.Encoding: Invalid UTF-8 stream" ``` diff --git a/unison-src/transcripts/abilities.md b/unison-src/transcripts/abilities.md index 3bf6c47ec1..a45ee504dd 100644 --- a/unison-src/transcripts/abilities.md +++ b/unison-src/transcripts/abilities.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Some random ability stuff to ensure things work. @@ -23,5 +23,5 @@ ha = cases ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/abilities.output.md b/unison-src/transcripts/abilities.output.md index c90d76a45d..aa162e135b 100644 --- a/unison-src/transcripts/abilities.output.md +++ b/unison-src/transcripts/abilities.output.md @@ -1,7 +1,6 @@ - Some random ability stuff to ensure things work. -```unison +``` unison unique ability A where one : Nat ->{A} Nat two : Nat -> Nat ->{A} Nat @@ -17,7 +16,7 @@ ha = cases { four i -> c } -> handle c (j k l -> i+j+k+l) with ha ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -31,8 +30,8 @@ ha = cases ha : Request {A} r -> r ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.md index 4a0606a4bd..2e00cc0c22 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.md @@ -15,6 +15,6 @@ term2 _ = () ``` ```ucm -.> add -.> names term1 +scratch/main> add +scratch/main> names term1 ``` diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md index 879dc0c624..a61dd00459 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md @@ -1,6 +1,6 @@ The order of a set of abilities is normalized before hashing. -```unison +``` unison unique ability Foo where foo : () @@ -14,7 +14,7 @@ term2 : () ->{Bar, Foo} () term2 _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -30,8 +30,8 @@ term2 _ = () term2 : '{Bar, Foo} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ term2 _ = () term1 : '{Bar, Foo} () term2 : '{Bar, Foo} () -.> names term1 +scratch/main> names term1 Term Hash: #8hum58rlih diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.md b/unison-src/transcripts/ability-term-conflicts-on-update.md index 04810a4939..6a1a316a50 100644 --- a/unison-src/transcripts/ability-term-conflicts-on-update.md +++ b/unison-src/transcripts/ability-term-conflicts-on-update.md @@ -3,7 +3,7 @@ https://github.com/unisonweb/unison/issues/2786 ```ucm:hide -.ns> builtins.merge +scratch/main> builtins.merge lib.builtins ``` First we add an ability to the codebase. @@ -15,7 +15,7 @@ unique ability Channels where ``` ```ucm -.ns> add +scratch/main> add ``` Now we update the ability, changing the name of the constructor, _but_, we simultaneously @@ -36,8 +36,8 @@ thing _ = send 1 These should fail with a term/ctor conflict since we exclude the ability from the update. ```ucm:error -.ns> update.old patch Channels.send -.ns> update.old patch thing +scratch/main> update.old patch Channels.send +scratch/main> update.old patch thing ``` If however, `Channels.send` and `thing` _depend_ on `Channels`, updating them should succeed since it pulls in the ability as a dependency. @@ -56,20 +56,20 @@ thing _ = send 1 These updates should succeed since `Channels` is a dependency. ```ucm -.ns> update.old.preview patch Channels.send -.ns> update.old.preview patch thing +scratch/main> update.old.preview patch Channels.send +scratch/main> update.old.preview patch thing ``` We should also be able to successfully update the whole thing. ```ucm -.ns> update.old +scratch/main> update.old ``` # Constructor-term conflict ```ucm:hide -.ns2> builtins.merge +scratch/main2> builtins.merge lib.builtins ``` @@ -78,7 +78,7 @@ X.x = 1 ``` ```ucm -.ns2> add +scratch/main2> add ``` ```unison @@ -89,5 +89,5 @@ structural ability X where This should fail with a ctor/term conflict. ```ucm:error -.ns2> add +scratch/main2> add ``` diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.output.md b/unison-src/transcripts/ability-term-conflicts-on-update.output.md index 901446e8d4..f5580e7b80 100644 --- a/unison-src/transcripts/ability-term-conflicts-on-update.output.md +++ b/unison-src/transcripts/ability-term-conflicts-on-update.output.md @@ -5,12 +5,12 @@ https://github.com/unisonweb/unison/issues/2786 First we add an ability to the codebase. Note that this will create the name `Channels.send` as an ability constructor. -```unison +``` unison unique ability Channels where send : a -> {Channels} () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,19 +23,19 @@ unique ability Channels where ability Channels ``` -```ucm -.ns> add +``` ucm +scratch/main> add ⍟ I've added these definitions: ability Channels ``` -Now we update the ability, changing the name of the constructor, _but_, we simultaneously +Now we update the ability, changing the name of the constructor, *but*, we simultaneously add a new top-level term with the same name as the constructor which is being removed from Channels. -```unison +``` unison unique ability Channels where sends : [a] -> {Channels} () @@ -46,7 +46,7 @@ thing : '{Channels} () thing _ = send 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -67,8 +67,8 @@ thing _ = send 1 ``` These should fail with a term/ctor conflict since we exclude the ability from the update. -```ucm -.ns> update.old patch Channels.send +``` ucm +scratch/main> update.old patch Channels.send x These definitions failed: @@ -77,7 +77,7 @@ These should fail with a term/ctor conflict since we exclude the ability from th Tip: Use `help filestatus` to learn more. -.ns> update.old patch thing +scratch/main> update.old patch thing ⍟ I've added these definitions: @@ -89,9 +89,9 @@ These should fail with a term/ctor conflict since we exclude the ability from th ability Channels ``` -If however, `Channels.send` and `thing` _depend_ on `Channels`, updating them should succeed since it pulls in the ability as a dependency. +If however, `Channels.send` and `thing` *depend* on `Channels`, updating them should succeed since it pulls in the ability as a dependency. -```unison +``` unison unique ability Channels where sends : [a] -> {Channels} () @@ -102,7 +102,7 @@ thing : '{Channels} () thing _ = send 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -121,8 +121,8 @@ thing _ = send 1 ``` These updates should succeed since `Channels` is a dependency. -```ucm -.ns> update.old.preview patch Channels.send +``` ucm +scratch/main> update.old.preview patch Channels.send I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would @@ -135,7 +135,7 @@ These updates should succeed since `Channels` is a dependency. Channels.send : a ->{Channels} () -.ns> update.old.preview patch thing +scratch/main> update.old.preview patch thing I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would @@ -152,8 +152,8 @@ These updates should succeed since `Channels` is a dependency. ``` We should also be able to successfully update the whole thing. -```ucm -.ns> update.old +``` ucm +scratch/main> update.old ⊡ Ignored previously added definitions: Channels @@ -165,11 +165,11 @@ We should also be able to successfully update the whole thing. ``` # Constructor-term conflict -```unison +``` unison X.x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -182,20 +182,20 @@ X.x = 1 X.x : Nat ``` -```ucm -.ns2> add +``` ucm +scratch/main2> add ⍟ I've added these definitions: X.x : Nat ``` -```unison +``` unison structural ability X where x : () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -214,8 +214,8 @@ structural ability X where ``` This should fail with a ctor/term conflict. -```ucm -.ns2> add +``` ucm +scratch/main2> add x These definitions failed: diff --git a/unison-src/transcripts/add-run.md b/unison-src/transcripts/add-run.md index 99ac7792e3..07fe99216d 100644 --- a/unison-src/transcripts/add-run.md +++ b/unison-src/transcripts/add-run.md @@ -3,7 +3,7 @@ ## Basic usage ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -20,26 +20,26 @@ is2even = '(even 2) it errors if there isn't a previous run ```ucm:error -.> add.run foo +scratch/main> add.run foo ``` ```ucm -.> run is2even +scratch/main> run is2even ``` it errors if the desired result name conflicts with a name in the unison file ```ucm:error -.> add.run is2even +scratch/main> add.run is2even ``` otherwise, the result is successfully persisted ```ucm -.> add.run foo.bar.baz +scratch/main> add.run foo.bar.baz ``` ```ucm -.> view foo.bar.baz +scratch/main> view foo.bar.baz ``` ## It resolves references within the unison file @@ -56,8 +56,8 @@ main _ = y ``` ```ucm -.> run main -.> add.run result +scratch/main> run main +scratch/main> add.run result ``` ## It resolves references within the codebase @@ -68,7 +68,7 @@ inc x = x + 1 ``` ```ucm -.> add inc +scratch/main> add inc ``` ```unison @@ -77,9 +77,9 @@ main _ x = inc x ``` ```ucm -.> run main -.> add.run natfoo -.> view natfoo +scratch/main> run main +scratch/main> add.run natfoo +scratch/main> view natfoo ``` ## It captures scratch file dependencies at run time @@ -91,7 +91,7 @@ main = 'y ``` ```ucm -.> run main +scratch/main> run main ``` @@ -101,8 +101,8 @@ x = 50 this saves 2 to xres, rather than 100 ```ucm -.> add.run xres -.> view xres +scratch/main> add.run xres +scratch/main> view xres ``` ## It fails with a message if add cannot complete cleanly @@ -112,8 +112,8 @@ main = '5 ``` ```ucm:error -.> run main -.> add.run xres +scratch/main> run main +scratch/main> add.run xres ``` ## It works with absolute names @@ -123,7 +123,7 @@ main = '5 ``` ```ucm -.> run main -.> add.run .an.absolute.name -.> view .an.absolute.name +scratch/main> run main +scratch/main> add.run .an.absolute.name +scratch/main> view .an.absolute.name ``` diff --git a/unison-src/transcripts/add-run.output.md b/unison-src/transcripts/add-run.output.md index 3d97788e78..76e52470c4 100644 --- a/unison-src/transcripts/add-run.output.md +++ b/unison-src/transcripts/add-run.output.md @@ -2,7 +2,7 @@ ## Basic usage -```unison +``` unison even : Nat -> Boolean even x = if x == 0 then true else odd (drop x 1) @@ -13,7 +13,7 @@ is2even : 'Boolean is2even = '(even 2) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -30,8 +30,8 @@ is2even = '(even 2) ``` it errors if there isn't a previous run -```ucm -.> add.run foo +``` ucm +scratch/main> add.run foo ⚠️ @@ -39,16 +39,17 @@ it errors if there isn't a previous run something before attempting to save it. ``` -```ucm -.> run is2even +``` ucm +scratch/main> run is2even true ``` it errors if the desired result name conflicts with a name in the unison file -```ucm -.> add.run is2even + +``` ucm +scratch/main> add.run is2even ⚠️ @@ -57,16 +58,17 @@ unison file ``` otherwise, the result is successfully persisted -```ucm -.> add.run foo.bar.baz + +``` ucm +scratch/main> add.run foo.bar.baz ⍟ I've added these definitions: foo.bar.baz : Boolean ``` -```ucm -.> view foo.bar.baz +``` ucm +scratch/main> view foo.bar.baz foo.bar.baz : Boolean foo.bar.baz = true @@ -74,7 +76,7 @@ otherwise, the result is successfully persisted ``` ## It resolves references within the unison file -```unison +``` unison z b = b Nat.+ 12 y a b = a Nat.+ b Nat.+ z 10 @@ -85,7 +87,7 @@ main : '{IO, Exception} (Nat -> Nat -> Nat) main _ = y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -100,12 +102,12 @@ main _ = y z : Nat -> Nat ``` -```ucm -.> run main +``` ucm +scratch/main> run main a b -> a Nat.+ b Nat.+ z 10 -.> add.run result +scratch/main> add.run result ⍟ I've added these definitions: @@ -115,12 +117,12 @@ main _ = y ``` ## It resolves references within the codebase -```unison +``` unison inc : Nat -> Nat inc x = x + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -133,20 +135,20 @@ inc x = x + 1 inc : Nat -> Nat ``` -```ucm -.> add inc +``` ucm +scratch/main> add inc ⍟ I've added these definitions: inc : Nat -> Nat ``` -```unison +``` unison main : '(Nat -> Nat) main _ x = inc x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -159,18 +161,18 @@ main _ x = inc x main : '(Nat -> Nat) ``` -```ucm -.> run main +``` ucm +scratch/main> run main inc -.> add.run natfoo +scratch/main> add.run natfoo ⍟ I've added these definitions: natfoo : Nat -> Nat -.> view natfoo +scratch/main> view natfoo natfoo : Nat -> Nat natfoo = inc @@ -178,13 +180,13 @@ main _ x = inc x ``` ## It captures scratch file dependencies at run time -```unison +``` unison x = 1 y = x + x main = 'y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -199,17 +201,17 @@ main = 'y y : Nat ``` -```ucm -.> run main +``` ucm +scratch/main> run main 2 ``` -```unison +``` unison x = 50 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -223,14 +225,15 @@ x = 50 ``` this saves 2 to xres, rather than 100 -```ucm -.> add.run xres + +``` ucm +scratch/main> add.run xres ⍟ I've added these definitions: xres : Nat -.> view xres +scratch/main> view xres xres : Nat xres = 2 @@ -238,11 +241,11 @@ this saves 2 to xres, rather than 100 ``` ## It fails with a message if add cannot complete cleanly -```unison +``` unison main = '5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -255,12 +258,12 @@ main = '5 main : 'Nat ``` -```ucm -.> run main +``` ucm +scratch/main> run main 5 -.> add.run xres +scratch/main> add.run xres x These definitions failed: @@ -272,11 +275,11 @@ main = '5 ``` ## It works with absolute names -```unison +``` unison main = '5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -289,18 +292,18 @@ main = '5 main : 'Nat ``` -```ucm -.> run main +``` ucm +scratch/main> run main 5 -.> add.run .an.absolute.name +scratch/main> add.run .an.absolute.name ⍟ I've added these definitions: .an.absolute.name : Nat -.> view .an.absolute.name +scratch/main> view .an.absolute.name .an.absolute.name : Nat .an.absolute.name = 5 diff --git a/unison-src/transcripts/add-test-watch-roundtrip.md b/unison-src/transcripts/add-test-watch-roundtrip.md index e8d070d2b1..9b1cacf477 100644 --- a/unison-src/transcripts/add-test-watch-roundtrip.md +++ b/unison-src/transcripts/add-test-watch-roundtrip.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -10,6 +10,6 @@ foo = [] Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though! ```ucm -.> add -.> view foo +scratch/main> add +scratch/main> view foo ``` diff --git a/unison-src/transcripts/add-test-watch-roundtrip.output.md b/unison-src/transcripts/add-test-watch-roundtrip.output.md index 5c9389ca1f..5366a47342 100644 --- a/unison-src/transcripts/add-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/add-test-watch-roundtrip.output.md @@ -1,18 +1,18 @@ -```unison +``` unison test> foo : [Test.Result] foo = [] ``` -Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though! +Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though\! -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: foo : [Result] -.> view foo +scratch/main> view foo foo : [Result] foo : [Result] diff --git a/unison-src/transcripts/addupdatemessages.md b/unison-src/transcripts/addupdatemessages.md index c644d921a0..9c7daea43f 100644 --- a/unison-src/transcripts/addupdatemessages.md +++ b/unison-src/transcripts/addupdatemessages.md @@ -3,7 +3,7 @@ Let's set up some definitions to start: ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -17,7 +17,7 @@ structural type Y = Two Nat Nat Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. ```ucm -.> add +scratch/main> add ``` Let's add an alias for `1` and `One`: @@ -32,7 +32,7 @@ Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. Also, `Z` is an alias for `X`. ```ucm -.> add +scratch/main> add ``` Let's update something that has an alias (to a value that doesn't have a name already): @@ -45,7 +45,7 @@ structural type X = Three Nat Nat Nat Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. ```ucm -.> update +scratch/main> update ``` Update it to something that already exists with a different name: @@ -58,6 +58,6 @@ structural type X = Two Nat Nat Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/addupdatemessages.output.md b/unison-src/transcripts/addupdatemessages.output.md index 44925f17c8..cbf0552713 100644 --- a/unison-src/transcripts/addupdatemessages.output.md +++ b/unison-src/transcripts/addupdatemessages.output.md @@ -2,7 +2,7 @@ Let's set up some definitions to start: -```unison +``` unison x = 1 y = 2 @@ -10,7 +10,7 @@ structural type X = One Nat structural type Y = Two Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,8 +28,8 @@ structural type Y = Two Nat Nat ``` Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -41,13 +41,13 @@ Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. ``` Let's add an alias for `1` and `One`: -```unison +``` unison z = 1 structural type Z = One Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -66,8 +66,8 @@ structural type Z = One Nat Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. Also, `Z` is an alias for `X`. -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -79,12 +79,12 @@ Also, `Z` is an alias for `X`. ``` Let's update something that has an alias (to a value that doesn't have a name already): -```unison +``` unison x = 3 structural type X = Three Nat Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -103,8 +103,8 @@ structural type X = Three Nat Nat Nat ``` Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -118,12 +118,12 @@ Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old ``` Update it to something that already exists with a different name: -```unison +``` unison x = 2 structural type X = Two Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -142,8 +142,8 @@ structural type X = Two Nat Nat ``` Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/alias-many.md b/unison-src/transcripts/alias-many.md index c682faf22b..57450c64dc 100644 --- a/unison-src/transcripts/alias-many.md +++ b/unison-src/transcripts/alias-many.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge lib.builtins ``` ```unison:hide:all List.adjacentPairs : [a] -> [(a, a)] @@ -95,14 +95,14 @@ List.takeWhile p xs = go xs [] ``` ```ucm:hide -.stuff> add +scratch/main> add ``` The `alias.many` command can be used to copy definitions from the current namespace into your curated one. The names that will be used in the target namespace are the names you specify, relative to the current namespace: ``` -.> help alias.many +scratch/main> help alias.many alias.many (or copy) `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... @@ -113,8 +113,8 @@ The names that will be used in the target namespace are the names you specify, r Let's try it! ```ucm -.> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib -.> find-in mylib +scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib +scratch/main> find-in mylib ``` Thanks, `alias.many`! diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index 8236c60d04..0e2114f88e 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -1,69 +1,66 @@ The `alias.many` command can be used to copy definitions from the current namespace into your curated one. The names that will be used in the target namespace are the names you specify, relative to the current namespace: -``` -.> help alias.many +``` +scratch/main> help alias.many alias.many (or copy) `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... in the namespace `namespace`. `alias.many foo.foo bar.bar .quux` creates aliases `.quux.foo.foo` and `.quux.bar.bar`. - ``` -Let's try it! +Let's try it\! -```ucm -.> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib +``` ucm +scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib - Here's what changed in .mylib : + Here's what changed in mylib : Added definitions: - 1. stuff.List.adjacentPairs : [a] -> [(a, a)] - 2. stuff.List.all : (a ->{g} Boolean) - -> [a] - ->{g} Boolean - 3. stuff.List.any : (a ->{g} Boolean) - -> [a] - ->{g} Boolean - 4. stuff.List.chunk : Nat -> [a] -> [[a]] - 5. stuff.List.chunksOf : Nat -> [a] -> [[a]] - 6. stuff.List.dropWhile : (a ->{g} Boolean) - -> [a] - ->{g} [a] - 7. stuff.List.first : [a] -> Optional a - 8. stuff.List.init : [a] -> Optional [a] - 9. stuff.List.intersperse : a -> [a] -> [a] - 10. stuff.List.isEmpty : [a] -> Boolean - 11. stuff.List.last : [a] -> Optional a - 12. stuff.List.replicate : Nat -> a -> [a] - 13. stuff.List.splitAt : Nat -> [a] -> ([a], [a]) - 14. stuff.List.tail : [a] -> Optional [a] - 15. stuff.List.takeWhile : (a ->{𝕖} Boolean) - -> [a] - ->{𝕖} [a] + 1. List.adjacentPairs : [a] -> [(a, a)] + 2. List.all : (a ->{g} Boolean) + -> [a] + ->{g} Boolean + 3. List.any : (a ->{g} Boolean) + -> [a] + ->{g} Boolean + 4. List.chunk : Nat -> [a] -> [[a]] + 5. List.chunksOf : Nat -> [a] -> [[a]] + 6. List.dropWhile : (a ->{g} Boolean) -> [a] ->{g} [a] + 7. List.first : [a] -> Optional a + 8. List.init : [a] -> Optional [a] + 9. List.intersperse : a -> [a] -> [a] + 10. List.isEmpty : [a] -> Boolean + 11. List.last : [a] -> Optional a + 12. List.replicate : Nat -> a -> [a] + 13. List.splitAt : Nat -> [a] -> ([a], [a]) + 14. List.tail : [a] -> Optional [a] + 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -.> find-in mylib +scratch/main> find-in mylib - 1. stuff.List.adjacentPairs : [a] -> [(a, a)] - 2. stuff.List.all : (a ->{g} Boolean) -> [a] ->{g} Boolean - 3. stuff.List.any : (a ->{g} Boolean) -> [a] ->{g} Boolean - 4. stuff.List.chunk : Nat -> [a] -> [[a]] - 5. stuff.List.chunksOf : Nat -> [a] -> [[a]] - 6. stuff.List.dropWhile : (a ->{g} Boolean) -> [a] ->{g} [a] - 7. stuff.List.first : [a] -> Optional a - 8. stuff.List.init : [a] -> Optional [a] - 9. stuff.List.intersperse : a -> [a] -> [a] - 10. stuff.List.isEmpty : [a] -> Boolean - 11. stuff.List.last : [a] -> Optional a - 12. stuff.List.replicate : Nat -> a -> [a] - 13. stuff.List.splitAt : Nat -> [a] -> ([a], [a]) - 14. stuff.List.tail : [a] -> Optional [a] - 15. stuff.List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] + 1. List.adjacentPairs : [a] -> [(a, a)] + 2. List.all : (a ->{g} Boolean) -> [a] ->{g} Boolean + 3. List.any : (a ->{g} Boolean) -> [a] ->{g} Boolean + 4. List.chunk : Nat -> [a] -> [[a]] + 5. List.chunksOf : Nat -> [a] -> [[a]] + 6. List.dropWhile : (a ->{g} Boolean) -> [a] ->{g} [a] + 7. List.first : [a] -> Optional a + 8. List.init : [a] -> Optional [a] + 9. List.intersperse : a -> [a] -> [a] + 10. List.isEmpty : [a] -> Boolean + 11. List.last : [a] -> Optional a + 12. List.replicate : Nat -> a -> [a] + 13. List.splitAt : Nat -> [a] -> ([a], [a]) + 14. List.tail : [a] -> Optional [a] + 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] ``` -Thanks, `alias.many! +Thanks, `alias.many`\! + diff --git a/unison-src/transcripts/alias-term.md b/unison-src/transcripts/alias-term.md new file mode 100644 index 0000000000..1e1bb95ec6 --- /dev/null +++ b/unison-src/transcripts/alias-term.md @@ -0,0 +1,27 @@ +`alias.term` makes a new name for a term. + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```ucm +project/main> alias.term lib.builtins.bug foo +project/main> ls +``` + +It won't create a conflicted name, though. + +```ucm:error +project/main> alias.term lib.builtins.todo foo +``` + +```ucm +project/main> ls +``` + +You can use `debug.alias.term.force` for that. + +```ucm +project/main> debug.alias.term.force lib.builtins.todo foo +project/main> ls +``` diff --git a/unison-src/transcripts/alias-term.output.md b/unison-src/transcripts/alias-term.output.md new file mode 100644 index 0000000000..2c120239e2 --- /dev/null +++ b/unison-src/transcripts/alias-term.output.md @@ -0,0 +1,44 @@ +`alias.term` makes a new name for a term. + +``` ucm +project/main> alias.term lib.builtins.bug foo + + Done. + +project/main> ls + + 1. foo (a -> b) + 2. lib/ (643 terms, 92 types) + +``` +It won't create a conflicted name, though. + +``` ucm +project/main> alias.term lib.builtins.todo foo + + ⚠️ + + A term by that name already exists. + +``` +``` ucm +project/main> ls + + 1. foo (a -> b) + 2. lib/ (643 terms, 92 types) + +``` +You can use `debug.alias.term.force` for that. + +``` ucm +project/main> debug.alias.term.force lib.builtins.todo foo + + Done. + +project/main> ls + + 1. foo (a -> b) + 2. foo (a -> b) + 3. lib/ (643 terms, 92 types) + +``` diff --git a/unison-src/transcripts/alias-type.md b/unison-src/transcripts/alias-type.md new file mode 100644 index 0000000000..b167daa2cc --- /dev/null +++ b/unison-src/transcripts/alias-type.md @@ -0,0 +1,28 @@ +`alias.type` makes a new name for a type. + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```ucm +project/main> alias.type lib.builtins.Nat Foo +project/main> ls +``` + +It won't create a conflicted name, though. + +```ucm:error +project/main> alias.type lib.builtins.Int Foo +``` + +```ucm +project/main> ls +``` + +You can use `debug.alias.type.force` for that. + +```ucm +project/main> debug.alias.type.force lib.builtins.Int Foo +project/main> ls +``` + diff --git a/unison-src/transcripts/alias-type.output.md b/unison-src/transcripts/alias-type.output.md new file mode 100644 index 0000000000..79a2fbcd7a --- /dev/null +++ b/unison-src/transcripts/alias-type.output.md @@ -0,0 +1,44 @@ +`alias.type` makes a new name for a type. + +``` ucm +project/main> alias.type lib.builtins.Nat Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) + +``` +It won't create a conflicted name, though. + +``` ucm +project/main> alias.type lib.builtins.Int Foo + + ⚠️ + + A type by that name already exists. + +``` +``` ucm +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) + +``` +You can use `debug.alias.type.force` for that. + +``` ucm +project/main> debug.alias.type.force lib.builtins.Int Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. Foo (builtin type) + 3. lib/ (643 terms, 92 types) + +``` diff --git a/unison-src/transcripts/anf-tests.md b/unison-src/transcripts/anf-tests.md index 122a673060..2a15836eb2 100644 --- a/unison-src/transcripts/anf-tests.md +++ b/unison-src/transcripts/anf-tests.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This tests a variable related bug in the ANF compiler. @@ -29,6 +29,6 @@ foo _ = ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/anf-tests.output.md b/unison-src/transcripts/anf-tests.output.md index c200d1056f..f58ad3bc0d 100644 --- a/unison-src/transcripts/anf-tests.output.md +++ b/unison-src/transcripts/anf-tests.output.md @@ -1,15 +1,16 @@ - This tests a variable related bug in the ANF compiler. The nested let would get flattened out, resulting in: - bar = result +``` +bar = result +``` -which would be handled by renaming. However, the _context_ portion of +which would be handled by renaming. However, the *context* portion of the rest of the code was not being renamed correctly, so `bar` would remain in the definition of `baz`. -```unison +``` unison foo _ = id x = x void x = () @@ -24,7 +25,7 @@ foo _ = > !foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,8 +45,8 @@ foo _ = 5 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/any-extract.md b/unison-src/transcripts/any-extract.md index 5e9d09324e..e65b36606f 100644 --- a/unison-src/transcripts/any-extract.md +++ b/unison-src/transcripts/any-extract.md @@ -1,9 +1,9 @@ # Unit tests for Any.unsafeExtract ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` Any.unsafeExtract is a way to extract the value contained in an Any. This is unsafe because it allows the programmer to coerce a value into any type, which would cause undefined behaviour if used to coerce a value to the wrong type. @@ -19,5 +19,5 @@ test> Any.unsafeExtract.works = ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/any-extract.output.md b/unison-src/transcripts/any-extract.output.md index 75567fb411..342ef3fbbc 100644 --- a/unison-src/transcripts/any-extract.output.md +++ b/unison-src/transcripts/any-extract.output.md @@ -2,7 +2,7 @@ Any.unsafeExtract is a way to extract the value contained in an Any. This is unsafe because it allows the programmer to coerce a value into any type, which would cause undefined behaviour if used to coerce a value to the wrong type. -```unison +``` unison test> Any.unsafeExtract.works = use Nat != checks [1 == Any.unsafeExtract (Any 1), @@ -11,7 +11,7 @@ test> Any.unsafeExtract.works = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -31,8 +31,8 @@ test> Any.unsafeExtract.works = ✅ Passed Passed ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/api-doc-rendering.md b/unison-src/transcripts/api-doc-rendering.md index 6deffaaba8..eb0d956949 100644 --- a/unison-src/transcripts/api-doc-rendering.md +++ b/unison-src/transcripts/api-doc-rendering.md @@ -1,7 +1,7 @@ # Doc rendering ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -82,13 +82,13 @@ term = 42 ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> display term.doc +scratch/main> display term.doc ``` ```api -GET /api/non-project-code/getDefinition?names=term +GET /api/projects/scratch/branches/main/getDefinition?names=term ``` diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index cac34211af..1ecf4f86a3 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -1,6 +1,6 @@ # Doc rendering -```unison +``` unison structural type Maybe a = Nothing | Just a otherTerm = "text" @@ -77,8 +77,8 @@ Transclusion/evaluation: term = 42 ``` -```ucm -.> display term.doc +``` ucm +scratch/main> display term.doc # Heading @@ -146,8 +146,8 @@ term = 42 message ``` -```api -GET /api/non-project-code/getDefinition?names=term +``` api +GET /api/projects/scratch/branches/main/getDefinition?names=term { "missingDefinitions": [], "termDefinitions": { @@ -940,4 +940,5 @@ GET /api/non-project-code/getDefinition?names=term }, "typeDefinitions": {} } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-find.md b/unison-src/transcripts/api-find.md index 201d3cad85..f11d98bfcb 100644 --- a/unison-src/transcripts/api-find.md +++ b/unison-src/transcripts/api-find.md @@ -8,19 +8,19 @@ joey.yaml.zz = 45 ``` ```ucm -.> add +scratch/main> add ``` ```api -- Namespace segment prefix search -GET /api/non-project-code/find?query=http +GET /api/projects/scratch/branches/main/find?query=http -- Namespace segment suffix search -GET /api/non-project-code/find?query=Server +GET /api/projects/scratch/branches/main/find?query=Server -- Substring search -GET /api/non-project-code/find?query=lesys +GET /api/projects/scratch/branches/main/find?query=lesys -- Cross-segment search -GET /api/non-project-code/find?query=joey.http +GET /api/projects/scratch/branches/main/find?query=joey.http ``` diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index 6505a1a320..2d062550b9 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -1,13 +1,13 @@ # find api -```unison +``` unison rachel.filesystem.x = 42 ross.httpClient.y = 43 joey.httpServer.z = 44 joey.yaml.zz = 45 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,8 +23,8 @@ joey.yaml.zz = 45 ross.httpClient.y : ##Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -34,9 +34,9 @@ joey.yaml.zz = 45 ross.httpClient.y : ##Nat ``` -```api +``` api -- Namespace segment prefix search -GET /api/non-project-code/find?query=http +GET /api/projects/scratch/branches/main/find?query=http [ [ { @@ -122,7 +122,7 @@ GET /api/non-project-code/find?query=http ] ] -- Namespace segment suffix search -GET /api/non-project-code/find?query=Server +GET /api/projects/scratch/branches/main/find?query=Server [ [ { @@ -167,7 +167,7 @@ GET /api/non-project-code/find?query=Server ] ] -- Substring search -GET /api/non-project-code/find?query=lesys +GET /api/projects/scratch/branches/main/find?query=lesys [ [ { @@ -212,7 +212,7 @@ GET /api/non-project-code/find?query=lesys ] ] -- Cross-segment search -GET /api/non-project-code/find?query=joey.http +GET /api/projects/scratch/branches/main/find?query=joey.http [ [ { @@ -252,4 +252,5 @@ GET /api/non-project-code/find?query=joey.http } ] ] -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-getDefinition.md b/unison-src/transcripts/api-getDefinition.md index 4a56b2bc9e..94f2341e74 100644 --- a/unison-src/transcripts/api-getDefinition.md +++ b/unison-src/transcripts/api-getDefinition.md @@ -1,54 +1,50 @@ # Get Definitions Test ```ucm:hide -.nested> builtins.mergeio +scratch/main> builtins.mergeio lib.builtins ``` ```unison:hide -{{ Documentation }} -names.x = 42 +nested.names.x.doc = {{ Documentation }} +nested.names.x = 42 ``` ```ucm:hide -.nested> add +scratch/main> add ``` ```api -- Should NOT find names by suffix -GET /api/non-project-code/getDefinition?names=x +GET /api/projects/scratch/branches/main/getDefinition?names=x -- Term names should strip relativeTo prefix. -GET /api/non-project-code/getDefinition?names=names.x&relativeTo=nested +GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested -- Should find definitions by hash, names should be relative -GET /api/non-project-code/getDefinition?names=%23qkhkl0n238&relativeTo=nested -``` - -```ucm:hide -.doctest> builtins.mergeio +GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested ``` ```unison:hide -thing.doc = {{ The correct docs for the thing }} -thing = "A thing" -thingalias.doc = {{ Docs for the alias, should not be displayed }} -thingalias = "A thing" -otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} -otherstuff.thing = "A different thing" +doctest.thing.doc = {{ The correct docs for the thing }} +doctest.thing = "A thing" +doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} +doctest.thingalias = "A thing" +doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} +doctest.otherstuff.thing = "A different thing" ``` ```ucm:hide -.doctest> add +scratch/main> add ``` Only docs for the term we request should be returned, even if there are other term docs with the same suffix. ```api -GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest +GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest ``` If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. ```api -GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest +GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest ``` diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index 24debb744d..edf49323c5 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -1,13 +1,13 @@ # Get Definitions Test -```unison -{{ Documentation }} -names.x = 42 +``` unison +nested.names.x.doc = {{ Documentation }} +nested.names.x = 42 ``` -```api +``` api -- Should NOT find names by suffix -GET /api/non-project-code/getDefinition?names=x +GET /api/projects/scratch/branches/main/getDefinition?names=x { "missingDefinitions": [ "x" @@ -16,7 +16,7 @@ GET /api/non-project-code/getDefinition?names=x "typeDefinitions": {} } -- Term names should strip relativeTo prefix. -GET /api/non-project-code/getDefinition?names=names.x&relativeTo=nested +GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested { "missingDefinitions": [], "termDefinitions": { @@ -104,14 +104,14 @@ GET /api/non-project-code/getDefinition?names=names.x&relativeTo=nested ] ], "termNames": [ - "names.x" + "nested.names.x" ] } }, "typeDefinitions": {} } -- Should find definitions by hash, names should be relative -GET /api/non-project-code/getDefinition?names=%23qkhkl0n238&relativeTo=nested +GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested { "missingDefinitions": [], "termDefinitions": { @@ -199,30 +199,32 @@ GET /api/non-project-code/getDefinition?names=%23qkhkl0n238&relativeTo=nested ] ], "termNames": [ - "names.x" + "nested.names.x" ] } }, "typeDefinitions": {} } -``````unison -thing.doc = {{ The correct docs for the thing }} -thing = "A thing" -thingalias.doc = {{ Docs for the alias, should not be displayed }} -thingalias = "A thing" -otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} -otherstuff.thing = "A different thing" +``` + +``` unison +doctest.thing.doc = {{ The correct docs for the thing }} +doctest.thing = "A thing" +doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} +doctest.thingalias = "A thing" +doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} +doctest.otherstuff.thing = "A different thing" ``` Only docs for the term we request should be returned, even if there are other term docs with the same suffix. -```api -GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest +``` api +GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest { "missingDefinitions": [], "termDefinitions": { "#jksc1s5kud95ro5ivngossullt2oavsd41s3u48bch67jf3gknru5j6hmjslonkd5sdqs8mr8k4rrnef8fodngbg4sm7u6au564ekjg": { - "bestTermName": "thing", + "bestTermName": "doctest.thing", "defnTermTag": "Plain", "signature": [ { @@ -237,10 +239,10 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest "contents": [ { "annotation": { - "contents": "thing", + "contents": "doctest.thing", "tag": "HashQualifier" }, - "segment": "thing" + "segment": "doctest.thing" }, { "annotation": { @@ -265,10 +267,10 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest }, { "annotation": { - "contents": "thing", + "contents": "doctest.thing", "tag": "HashQualifier" }, - "segment": "thing" + "segment": "doctest.thing" }, { "annotation": { @@ -291,7 +293,7 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest }, "termDocs": [ [ - "thing.doc", + "doctest.thing.doc", "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", { "contents": [ @@ -325,22 +327,24 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest ] ], "termNames": [ - "thing", - "thingalias" + "doctest.thing", + "doctest.thingalias" ] } }, "typeDefinitions": {} } -```If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. +``` + +If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. -```api -GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest +``` api +GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest { "missingDefinitions": [], "termDefinitions": { "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o": { - "bestTermName": "thing.doc", + "bestTermName": "doctest.thing.doc", "defnTermTag": "Doc", "signature": [ { @@ -355,10 +359,10 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest "contents": [ { "annotation": { - "contents": "thing.doc", + "contents": "doctest.thing.doc", "tag": "HashQualifier" }, - "segment": "thing.doc" + "segment": "doctest.thing.doc" }, { "annotation": { @@ -383,10 +387,10 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest }, { "annotation": { - "contents": "thing.doc", + "contents": "doctest.thing.doc", "tag": "HashQualifier" }, - "segment": "thing.doc" + "segment": "doctest.thing.doc" }, { "annotation": { @@ -467,7 +471,7 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest }, "termDocs": [ [ - "thing.doc", + "doctest.thing.doc", "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", { "contents": [ @@ -501,10 +505,11 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest ] ], "termNames": [ - "thing.doc" + "doctest.thing.doc" ] } }, "typeDefinitions": {} } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-list-projects-branches.md b/unison-src/transcripts/api-list-projects-branches.md index 111489cf97..872cca22a7 100644 --- a/unison-src/transcripts/api-list-projects-branches.md +++ b/unison-src/transcripts/api-list-projects-branches.md @@ -1,9 +1,9 @@ # List Projects And Branches Test ```ucm:hide -.> project.create-empty project-one -.> project.create-empty project-two -.> project.create-empty project-three +scratch/main> project.create-empty project-one +scratch/main> project.create-empty project-two +scratch/main> project.create-empty project-three project-one/main> branch branch-one project-one/main> branch branch-two project-one/main> branch branch-three diff --git a/unison-src/transcripts/api-list-projects-branches.output.md b/unison-src/transcripts/api-list-projects-branches.output.md index 1c12eea541..0971ab5fc5 100644 --- a/unison-src/transcripts/api-list-projects-branches.output.md +++ b/unison-src/transcripts/api-list-projects-branches.output.md @@ -1,6 +1,6 @@ # List Projects And Branches Test -```api +``` api -- Should list all projects GET /api/projects [ @@ -12,6 +12,9 @@ GET /api/projects }, { "projectName": "project-two" + }, + { + "projectName": "scratch" } ] -- Should list projects starting with project-t @@ -50,4 +53,5 @@ GET /api/projects/project-one/branches?prefix=branch-t "branchName": "branch-two" } ] -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-namespace-details.md b/unison-src/transcripts/api-namespace-details.md index 0cfc7a8353..2d50bdae93 100644 --- a/unison-src/transcripts/api-namespace-details.md +++ b/unison-src/transcripts/api-namespace-details.md @@ -1,7 +1,7 @@ # Namespace Details Test ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -14,10 +14,10 @@ Here's a *README*! ``` ```ucm -.> add +scratch/main> add ``` ```api -- Should find names by suffix -GET /api/non-project-code/namespaces/nested.names +GET /api/projects/scratch/branches/main/namespaces/nested.names ``` diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 80d1d6ae0c..3ba09740f7 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -1,6 +1,6 @@ # Namespace Details Test -```unison +``` unison {{ Documentation }} nested.names.x = 42 @@ -9,7 +9,7 @@ Here's a *README*! }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,8 +24,8 @@ Here's a *README*! nested.names.x.doc : Doc2 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -34,9 +34,9 @@ Here's a *README*! nested.names.x.doc : Doc2 ``` -```api +``` api -- Should find names by suffix -GET /api/non-project-code/namespaces/nested.names +GET /api/projects/scratch/branches/main/namespaces/nested.names { "fqn": "nested.names", "hash": "#6tnmlu9knsce0u2991u6fvcmf4v44fdf0aiqtmnq7mjj0gi5sephg3lf12iv3odr5rc7vlgq75ciborrd3625c701bdmdomia2gcm3o", @@ -78,4 +78,5 @@ GET /api/non-project-code/namespaces/nested.names "tag": "Paragraph" } } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-namespace-list.md b/unison-src/transcripts/api-namespace-list.md index 717607269a..c3dbbeed13 100644 --- a/unison-src/transcripts/api-namespace-list.md +++ b/unison-src/transcripts/api-namespace-list.md @@ -1,7 +1,7 @@ # Namespace list api ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -12,11 +12,11 @@ nested.names.readme = {{ I'm a readme! }} ``` ```ucm -.> add +scratch/main> add ``` ```api -GET /api/non-project-code/list?namespace=nested.names +GET /api/projects/scratch/branches/main/list?namespace=nested.names -GET /api/non-project-code/list?namespace=names&relativeTo=nested +GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested ``` diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index 0ef32d1941..56a6e09498 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -1,13 +1,13 @@ # Namespace list api -```unison +``` unison {{ Documentation }} nested.names.x = 42 nested.names.readme = {{ I'm a readme! }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,8 +22,8 @@ nested.names.readme = {{ I'm a readme! }} nested.names.x.doc : Doc2 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -32,8 +32,8 @@ nested.names.readme = {{ I'm a readme! }} nested.names.x.doc : Doc2 ``` -```api -GET /api/non-project-code/list?namespace=nested.names +``` api +GET /api/projects/scratch/branches/main/list?namespace=nested.names { "namespaceListingChildren": [ { @@ -82,7 +82,7 @@ GET /api/non-project-code/list?namespace=nested.names "namespaceListingFQN": "nested.names", "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" } -GET /api/non-project-code/list?namespace=names&relativeTo=nested +GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested { "namespaceListingChildren": [ { @@ -131,4 +131,5 @@ GET /api/non-project-code/list?namespace=names&relativeTo=nested "namespaceListingFQN": "nested.names", "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-summaries.md b/unison-src/transcripts/api-summaries.md index cf473e778a..6bbc793a9f 100644 --- a/unison-src/transcripts/api-summaries.md +++ b/unison-src/transcripts/api-summaries.md @@ -1,7 +1,7 @@ # Definition Summary APIs ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` @@ -25,56 +25,56 @@ structural ability Stream s where ``` ```ucm:hide -.> add -.> alias.type ##Nat Nat -.> alias.term ##IO.putBytes.impl.v3 putBytesImpl +scratch/main> add +scratch/main> alias.type ##Nat Nat +scratch/main> alias.term ##IO.putBytes.impl.v3 putBytesImpl ``` ## Term Summary APIs ```api -- term -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat -- term without name uses hash -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary -- doc -GET /api/non-project-code/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc -- test -GET /api/non-project-code/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest -- function -GET /api/non-project-code/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func -- constructor -GET /api/non-project-code/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This -- Long type signature -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType -- Long type signature with render width -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType -- Builtin Term -GET /api/non-project-code/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl ``` ## Type Summary APIs ```api -- data -GET /api/non-project-code/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing -- data with type args -GET /api/non-project-code/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe -- ability -GET /api/non-project-code/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream -- builtin type -GET /api/non-project-code/definitions/types/by-hash/@@Nat/summary?name=Nat +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat ``` diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md index cc5a9fcea3..7ea0a5d197 100644 --- a/unison-src/transcripts/api-summaries.output.md +++ b/unison-src/transcripts/api-summaries.output.md @@ -1,6 +1,6 @@ # Definition Summary APIs -```unison +``` unison nat : Nat nat = 42 doc : Doc2 @@ -21,9 +21,9 @@ structural ability Stream s where ## Term Summary APIs -```api +``` api -- term -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat { "displayName": "nat", "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", @@ -42,7 +42,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sq "tag": "Plain" } -- term without name uses hash -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary { "displayName": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", @@ -61,7 +61,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sq "tag": "Plain" } -- doc -GET /api/non-project-code/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc { "displayName": "doc", "hash": "#icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo", @@ -80,7 +80,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bl "tag": "Doc" } -- test -GET /api/non-project-code/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest { "displayName": "mytest", "hash": "#u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8", @@ -111,7 +111,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccd "tag": "Test" } -- function -GET /api/non-project-code/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func { "displayName": "func", "hash": "#6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o", @@ -151,7 +151,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3o "tag": "Plain" } -- constructor -GET /api/non-project-code/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This { "displayName": "Thing.This", "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0#0", @@ -191,7 +191,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5ad "tag": "DataConstructor" } -- Long type signature -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType { "displayName": "funcWithLongType", "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", @@ -378,7 +378,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59tton "tag": "Plain" } -- Long type signature with render width -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType { "displayName": "funcWithLongType", "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", @@ -565,7 +565,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59tton "tag": "Plain" } -- Builtin Term -GET /api/non-project-code/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl { "displayName": "putBytesImpl", "hash": "##IO.putBytes.impl.v3", @@ -667,11 +667,13 @@ GET /api/non-project-code/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summar }, "tag": "Plain" } -```## Type Summary APIs +``` + +## Type Summary APIs -```api +``` api -- data -GET /api/non-project-code/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing { "displayName": "Thing", "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", @@ -710,7 +712,7 @@ GET /api/non-project-code/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5ad "tag": "Data" } -- data with type args -GET /api/non-project-code/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe { "displayName": "Maybe", "hash": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", @@ -759,7 +761,7 @@ GET /api/non-project-code/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6 "tag": "Data" } -- ability -GET /api/non-project-code/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream { "displayName": "Stream", "hash": "#rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8", @@ -808,7 +810,7 @@ GET /api/non-project-code/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aa "tag": "Ability" } -- builtin type -GET /api/non-project-code/definitions/types/by-hash/@@Nat/summary?name=Nat +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat { "displayName": "Nat", "hash": "##Nat", @@ -823,4 +825,5 @@ GET /api/non-project-code/definitions/types/by-hash/@@Nat/summary?name=Nat }, "tag": "Data" } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/block-on-required-update.md b/unison-src/transcripts/block-on-required-update.md index 1027188b06..3b339e6fe7 100644 --- a/unison-src/transcripts/block-on-required-update.md +++ b/unison-src/transcripts/block-on-required-update.md @@ -3,7 +3,7 @@ Should block an `add` if it requires an update on an in-file dependency. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ``` Update `x`, and add a new `y` which depends on the update @@ -24,5 +24,5 @@ y = x + 1 Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. ```ucm:error -.> add y +scratch/main> add y ``` diff --git a/unison-src/transcripts/block-on-required-update.output.md b/unison-src/transcripts/block-on-required-update.output.md index 254a281e87..20560c94c4 100644 --- a/unison-src/transcripts/block-on-required-update.output.md +++ b/unison-src/transcripts/block-on-required-update.output.md @@ -2,11 +2,11 @@ Should block an `add` if it requires an update on an in-file dependency. -```unison +``` unison x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,8 +19,8 @@ x = 1 x : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -29,12 +29,12 @@ x = 1 ``` Update `x`, and add a new `y` which depends on the update -```unison +``` unison x = 10 y = x + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -54,8 +54,8 @@ y = x + 1 ``` Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. -```ucm -.> add y +``` ucm +scratch/main> add y x These definitions failed: diff --git a/unison-src/transcripts/blocks.md b/unison-src/transcripts/blocks.md index bac7ef1874..b89ab45850 100644 --- a/unison-src/transcripts/blocks.md +++ b/unison-src/transcripts/blocks.md @@ -1,7 +1,7 @@ ## Blocks and scoping ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ### Names introduced by a block shadow names introduced in outer scopes diff --git a/unison-src/transcripts/blocks.output.md b/unison-src/transcripts/blocks.output.md index 687ca98067..f52ca4f259 100644 --- a/unison-src/transcripts/blocks.output.md +++ b/unison-src/transcripts/blocks.output.md @@ -4,7 +4,7 @@ For example: -```unison +``` unison ex thing = thing y = y -- refers to `thing` in this block @@ -15,7 +15,7 @@ ex thing = > ex "hello" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -39,7 +39,7 @@ ex thing = The `thing` reference in `bar` refers to the one declared locally in the block that `bar` is part of. This is true even if the declaration which shadows the outer name appears later in the block, for instance: -```unison +``` unison ex thing = bar x = thing x + 1 thing y = y @@ -48,7 +48,7 @@ ex thing = > ex "hello" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -72,7 +72,7 @@ ex thing = This is just the normal lexical scoping behavior. For example: -```unison +``` unison ex thing = bar x = thing x + 1 -- references outer `thing` baz z = @@ -83,7 +83,7 @@ ex thing = > ex (x -> x * 100) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -103,9 +103,9 @@ ex thing = 4201 ``` -Here's another example, showing that bindings cannot reference bindings declared in blocks nested in the _body_ (the final expression) of a block: +Here's another example, showing that bindings cannot reference bindings declared in blocks nested in the *body* (the final expression) of a block: -```unison +``` unison ex thing = bar x = thing x + 1 -- refers to outer thing let @@ -115,7 +115,7 @@ ex thing = > ex (x -> x * 100) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -137,9 +137,9 @@ ex thing = ``` ### Blocks can define one or more functions which are recursive or mutually recursive -We call these groups of definitions that reference each other in a block _cycles_. For instance: +We call these groups of definitions that reference each other in a block *cycles*. For instance: -```unison +``` unison sumTo n = -- A recursive function, defined inside a block go acc n = @@ -154,7 +154,7 @@ ex n = ping 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -174,14 +174,14 @@ The `go` function is a one-element cycle (it reference itself), and `ping` and ` For instance, this works: -```unison +``` unison ex n = ping x = pong + 1 + x pong = 42 ping 0 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -198,14 +198,14 @@ Since the forward reference to `pong` appears inside `ping`. This, however, will not compile: -```unison +``` unison ex n = pong = ping + 1 ping = 42 pong ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -217,13 +217,13 @@ ex n = ``` This also won't compile; it's a cyclic reference that isn't guarded: -```unison +``` unison ex n = loop = loop loop ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -234,13 +234,13 @@ ex n = ``` This, however, will compile. This also shows that `'expr` is another way of guarding a definition. -```unison +``` unison ex n = loop = '(!loop) !loop ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -253,13 +253,13 @@ ex n = ex : n -> r ``` -Just don't try to run it as it's an infinite loop! +Just don't try to run it as it's an infinite loop\! ### Cyclic definitions in a block don't have access to any abilities The reason is it's unclear what the order should be of any requests that are made. It can also be viewed of a special case of the restriction that elements of a cycle must all be guarded. Here's an example: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat @@ -269,7 +269,7 @@ ex n = zap1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -279,11 +279,11 @@ ex n = ``` -### The _body_ of recursive functions can certainly access abilities +### The *body* of recursive functions can certainly access abilities For instance, this works fine: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat @@ -293,7 +293,7 @@ ex n = zap1 "pluto" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -311,7 +311,7 @@ ex n = For instance, `zap` here isn't considered part of the cycle (it doesn't reference `ping` or `pong`), so this typechecks fine: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat @@ -322,7 +322,7 @@ ex n = ping 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -338,7 +338,7 @@ ex n = ``` This is actually parsed as if you moved `zap` after the cycle it find itself a part of: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat @@ -349,7 +349,7 @@ ex n = ping 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.md b/unison-src/transcripts/boolean-op-pretty-print-2819.md index efdf493e9f..b788c78334 100644 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.md +++ b/unison-src/transcripts/boolean-op-pretty-print-2819.md @@ -1,7 +1,7 @@ Regression test for https://github.com/unisonweb/unison/pull/2819 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -12,7 +12,7 @@ hangExample = ``` ```ucm -.> add -.> view hangExample +scratch/main> add +scratch/main> view hangExample ``` diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md index 690b9fdc6b..b840f4bbc0 100644 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md +++ b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md @@ -1,13 +1,13 @@ Regression test for https://github.com/unisonweb/unison/pull/2819 -```unison +``` unison hangExample : Boolean hangExample = ("a long piece of text to hang the line" == "") && ("a long piece of text to hang the line" == "") ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -20,14 +20,14 @@ hangExample = hangExample : Boolean ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: hangExample : Boolean -.> view hangExample +scratch/main> view hangExample hangExample : Boolean hangExample = diff --git a/unison-src/transcripts/branch-command.md b/unison-src/transcripts/branch-command.md index 4b1636be41..d48e3c259a 100644 --- a/unison-src/transcripts/branch-command.md +++ b/unison-src/transcripts/branch-command.md @@ -1,25 +1,25 @@ The `branch` command creates a new branch. ```ucm:hide -.> project.create-empty foo -.> project.create-empty bar +scratch/main> project.create-empty foo +scratch/main> project.create-empty bar ``` -First, we'll just create a loose code namespace with a term in it for later. +First, we'll create a term to include in the branches. ```unison:hide someterm = 18 ``` ```ucm -.some.loose.code.lib> builtins.merge -.some.loose.code> add +scratch/main> builtins.merge lib.builtins +scratch/main> add ``` Now, the `branch` demo: `branch` can create a branch from a different branch in the same project, from a different branch in a different -project, or from loose code. It can also create an empty branch. +project. It can also create an empty branch. ```ucm foo/main> branch topic1 @@ -33,22 +33,17 @@ foo/main> branch /main /topic8 foo/main> branch /main foo/topic9 foo/main> branch foo/main topic10 foo/main> branch foo/main /topic11 -.> branch foo/main foo/topic12 +scratch/main> branch foo/main foo/topic12 foo/main> branch bar/topic bar/main> branch foo/main topic2 bar/main> branch foo/main /topic3 -.> branch foo/main bar/topic4 - -.some.loose.code> branch foo/topic13 -foo/main> branch .some.loose.code topic14 -foo/main> branch .some.loose.code /topic15 -.> branch .some.loose.code foo/topic16 +scratch/main> branch foo/main bar/topic4 foo/main> branch.empty empty1 foo/main> branch.empty /empty2 foo/main> branch.empty foo/empty3 -.> branch.empty foo/empty4 +scratch/main> branch.empty foo/empty4 ``` The `branch` command can create branches named `releases/drafts/*` (because why not). diff --git a/unison-src/transcripts/branch-command.output.md b/unison-src/transcripts/branch-command.output.md index c074134bbb..6a78b8e723 100644 --- a/unison-src/transcripts/branch-command.output.md +++ b/unison-src/transcripts/branch-command.output.md @@ -1,19 +1,17 @@ The `branch` command creates a new branch. -First, we'll just create a loose code namespace with a term in it for later. +First, we'll create a term to include in the branches. -```unison +``` unison someterm = 18 ``` -```ucm - ☝️ The namespace .some.loose.code.lib is empty. - -.some.loose.code.lib> builtins.merge +``` ucm +scratch/main> builtins.merge lib.builtins Done. -.some.loose.code> add +scratch/main> add ⍟ I've added these definitions: @@ -23,9 +21,9 @@ someterm = 18 Now, the `branch` demo: `branch` can create a branch from a different branch in the same project, from a different branch in a different -project, or from loose code. It can also create an empty branch. +project. It can also create an empty branch. -```ucm +``` ucm foo/main> branch topic1 Done. I've created the topic1 branch based off of main. @@ -103,7 +101,7 @@ foo/main> branch foo/main /topic11 Tip: To merge your work back into the main branch, first `switch /main` then `merge /topic11`. -.> branch foo/main foo/topic12 +scratch/main> branch foo/main foo/topic12 Done. I've created the topic12 branch based off of main. @@ -122,30 +120,10 @@ bar/main> branch foo/main /topic3 Done. I've created the bar/topic3 branch based off foo/main. -.> branch foo/main bar/topic4 +scratch/main> branch foo/main bar/topic4 Done. I've created the bar/topic4 branch based off foo/main. -.some.loose.code> branch foo/topic13 - - Done. I've created the foo/topic13 branch from the namespace - .some.loose.code. - -foo/main> branch .some.loose.code topic14 - - Done. I've created the foo/topic14 branch from the namespace - .some.loose.code. - -foo/main> branch .some.loose.code /topic15 - - Done. I've created the foo/topic15 branch from the namespace - .some.loose.code. - -.> branch .some.loose.code foo/topic16 - - Done. I've created the foo/topic16 branch from the namespace - .some.loose.code. - foo/main> branch.empty empty1 Done. I've created an empty branch foo/empty1. @@ -164,7 +142,7 @@ foo/main> branch.empty foo/empty3 Tip: Use `merge /somebranch` to initialize this branch. -.> branch.empty foo/empty4 +scratch/main> branch.empty foo/empty4 Done. I've created an empty branch foo/empty4. @@ -173,7 +151,7 @@ foo/main> branch.empty foo/empty3 ``` The `branch` command can create branches named `releases/drafts/*` (because why not). -```ucm +``` ucm foo/main> branch releases/drafts/1.2.3 Done. I've created the releases/drafts/1.2.3 branch based off @@ -187,7 +165,7 @@ foo/main> switch /releases/drafts/1.2.3 ``` The `branch` command can't create branches named `releases/*` nor `releases/drafts/*`. -```ucm +``` ucm foo/main> branch releases/1.2.3 Branch names like releases/1.2.3 are reserved for releases. diff --git a/unison-src/transcripts/branch-relative-path.md b/unison-src/transcripts/branch-relative-path.md index 8414db2f16..77de247037 100644 --- a/unison-src/transcripts/branch-relative-path.md +++ b/unison-src/transcripts/branch-relative-path.md @@ -1,9 +1,3 @@ -```ucm:hide -.> builtins.merge -.> project.create-empty p0 -.> project.create-empty p1 -``` - ```unison foo = 5 foo.bar = 1 diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md index 4f2be5861a..e9e33b5ad9 100644 --- a/unison-src/transcripts/branch-relative-path.output.md +++ b/unison-src/transcripts/branch-relative-path.output.md @@ -1,9 +1,9 @@ -```unison +``` unison foo = 5 foo.bar = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ foo.bar = 1 foo.bar : ##Nat ``` -```ucm +``` ucm p0/main> add ⍟ I've added these definitions: @@ -26,12 +26,12 @@ p0/main> add foo.bar : ##Nat ``` -```unison +``` unison bonk = 5 donk.bonk = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ donk.bonk = 1 (also named foo.bar) ``` -```ucm +``` ucm p1/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/bug-fix-4354.md b/unison-src/transcripts/bug-fix-4354.md index c1d603258d..1ea7f595dd 100644 --- a/unison-src/transcripts/bug-fix-4354.md +++ b/unison-src/transcripts/bug-fix-4354.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/bug-fix-4354.output.md b/unison-src/transcripts/bug-fix-4354.output.md index ca99d870dd..110aca0022 100644 --- a/unison-src/transcripts/bug-fix-4354.output.md +++ b/unison-src/transcripts/bug-fix-4354.output.md @@ -1,4 +1,4 @@ -```unison +``` unison bonk : forall a. a -> a bonk x = zonk : forall a. a -> a @@ -8,7 +8,7 @@ bonk x = x ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/bug-strange-closure.md b/unison-src/transcripts/bug-strange-closure.md index f2f805d682..75c4064db3 100644 --- a/unison-src/transcripts/bug-strange-closure.md +++ b/unison-src/transcripts/bug-strange-closure.md @@ -1,15 +1,15 @@ ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/doc.md.files/syntax.u +scratch/main> builtins.mergeio lib.builtins +scratch/main> load unison-src/transcripts-using-base/doc.md.files/syntax.u ``` We can display the guide before and after adding it to the codebase: ```ucm -.> display doc.guide -.> add -.> display doc.guide +scratch/main> display doc.guide +scratch/main> add +scratch/main> display doc.guide ``` But we can't display this due to a decompilation problem. @@ -19,10 +19,10 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` ```ucm -.> display rendered -.> add -.> display rendered -.> undo +scratch/main> display rendered +scratch/main> add +scratch/main> display rendered +scratch/main> undo ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 8b9f7fa75c..bad237d05f 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -1,8 +1,7 @@ - We can display the guide before and after adding it to the codebase: -```ucm -.> display doc.guide +``` ucm +scratch/main> display doc.guide # Unison computable documentation @@ -200,7 +199,7 @@ We can display the guide before and after adding it to the codebase: rendered table. Some text More text Zounds! -.> add +scratch/main> add ⍟ I've added these definitions: @@ -213,7 +212,7 @@ We can display the guide before and after adding it to the codebase: otherElements : Doc2 sqr : Nat -> Nat -.> display doc.guide +scratch/main> display doc.guide # Unison computable documentation @@ -414,11 +413,11 @@ We can display the guide before and after adding it to the codebase: ``` But we can't display this due to a decompilation problem. -```unison +``` unison rendered = Pretty.get (docFormatConsole doc.guide) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -431,8 +430,8 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered : Annotated () (Either SpecialForm ConsoleText) ``` -```ucm -.> display rendered +``` ucm +scratch/main> display rendered # Unison computable documentation @@ -630,13 +629,13 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered table. Some text More text Zounds! -.> add +scratch/main> add ⍟ I've added these definitions: rendered : Annotated () (Either SpecialForm ConsoleText) -.> display rendered +scratch/main> display rendered # Unison computable documentation @@ -834,7 +833,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered table. Some text More text Zounds! -.> undo +scratch/main> undo Here are the changes I undid @@ -845,13 +844,13 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. -```unison +``` unison rendered = Pretty.get (docFormatConsole doc.guide) > rendered ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/builtins-merge.md b/unison-src/transcripts/builtins-merge.md index 28bfb426ca..942dd4b0d3 100644 --- a/unison-src/transcripts/builtins-merge.md +++ b/unison-src/transcripts/builtins-merge.md @@ -1,6 +1,6 @@ -The `builtins.merge` command adds the known builtins to a `builtin` subnamespace within the current namespace. +The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. ```ucm -.tmp> builtins.merge -.tmp> ls builtin +scratch/main> builtins.merge builtins +scratch/main> ls builtins ``` diff --git a/unison-src/transcripts/builtins-merge.output.md b/unison-src/transcripts/builtins-merge.output.md index 7bcf4910ec..8147375776 100644 --- a/unison-src/transcripts/builtins-merge.output.md +++ b/unison-src/transcripts/builtins-merge.output.md @@ -1,13 +1,11 @@ -The `builtins.merge` command adds the known builtins to a `builtin` subnamespace within the current namespace. +The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. -```ucm - ☝️ The namespace .tmp is empty. - -.tmp> builtins.merge +``` ucm +scratch/main> builtins.merge builtins Done. -.tmp> ls builtin +scratch/main> ls builtins 1. Any (builtin type) 2. Any/ (2 terms) diff --git a/unison-src/transcripts/builtins.md b/unison-src/transcripts/builtins.md index ab854be39d..6834b85eb1 100644 --- a/unison-src/transcripts/builtins.md +++ b/unison-src/transcripts/builtins.md @@ -1,12 +1,12 @@ # Unit tests for builtin functions ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` -This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. +This transcript defines unit tests for builtin functions. There's a single `scratch/main> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. ## `Int` functions @@ -88,7 +88,7 @@ test> Int.tests.conversions = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Nat` functions @@ -163,7 +163,7 @@ test> Nat.tests.conversions = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Boolean` functions @@ -190,7 +190,7 @@ test> Boolean.tests.notTable = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Text` functions @@ -288,7 +288,7 @@ test> Text.tests.indexOfEmoji = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Bytes` functions @@ -352,7 +352,7 @@ test> Bytes.tests.indexOf = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `List` comparison @@ -371,7 +371,7 @@ test> checks [ ``` ```ucm:hide -.> add +scratch/main> add ``` Other list functions @@ -392,7 +392,7 @@ test> Any.test2 = checks [(not (Any "hi" == Any 42))] ``` ```ucm:hide -.> add +scratch/main> add ``` ## Sandboxing functions @@ -419,7 +419,7 @@ openFile] ``` ```ucm:hide -.> add +scratch/main> add ``` ```unison @@ -436,8 +436,8 @@ openFilesIO = do ``` ```ucm -.> add -.> io.test openFilesIO +scratch/main> add +scratch/main> io.test openFilesIO ``` ## Universal hash functions @@ -450,7 +450,7 @@ test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Unive ``` ```ucm:hide -.> add +scratch/main> add ``` ## Run the tests @@ -458,5 +458,5 @@ test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Unive Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. ```ucm -.> test +scratch/main> test ``` diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md index 4d3089d35e..3a4538f30a 100644 --- a/unison-src/transcripts/builtins.output.md +++ b/unison-src/transcripts/builtins.output.md @@ -1,10 +1,10 @@ # Unit tests for builtin functions -This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. +This transcript defines unit tests for builtin functions. There's a single `scratch/main> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. ## `Int` functions -```unison +``` unison use Int -- used for some take/drop tests later @@ -83,7 +83,7 @@ test> Int.tests.conversions = ## `Nat` functions -```unison +``` unison use Nat test> Nat.tests.arithmetic = @@ -153,7 +153,8 @@ test> Nat.tests.conversions = ``` ## `Boolean` functions -```unison + +``` unison test> Boolean.tests.orTable = checks [ true || true == true, @@ -177,7 +178,7 @@ test> Boolean.tests.notTable = ## `Text` functions -```unison +``` unison test> Text.tests.takeDropAppend = checks [ "yabba" ++ "dabba" == "yabbadabba", @@ -271,7 +272,7 @@ test> Text.tests.indexOfEmoji = ## `Bytes` functions -```unison +``` unison test> Bytes.tests.at = bs = Bytes.fromList [77, 13, 12] checks [ @@ -331,7 +332,7 @@ test> Bytes.tests.indexOf = ## `List` comparison -```unison +``` unison test> checks [ compare [] [1,2,3] == -1, compare [1,2,3] [1,2,3,4] == -1, @@ -345,7 +346,8 @@ test> checks [ ``` Other list functions -```unison + +``` unison test> checks [ List.take bigN [1,2,3] == [1,2,3], List.drop bigN [1,2,3] == [] @@ -354,14 +356,14 @@ test> checks [ ## `Any` functions -```unison +``` unison > [Any "hi", Any (41 + 1)] test> Any.test1 = checks [(Any "hi" == Any "hi")] test> Any.test2 = checks [(not (Any "hi" == Any 42))] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -392,7 +394,7 @@ test> Any.test2 = checks [(not (Any "hi" == Any 42))] ``` ## Sandboxing functions -```unison +``` unison openFile1 t = openFile t openFile2 t = openFile1 t @@ -413,7 +415,7 @@ test> Sandbox.test3 = checks [validateSandboxed [termLink openFile.impl] openFile] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -453,7 +455,7 @@ openFile] ✅ Passed Passed ``` -```unison +``` unison openFilesIO = do checks [ not (validateSandboxedSimpl [] (value openFile)) @@ -466,7 +468,7 @@ openFilesIO = do ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -479,34 +481,34 @@ openFilesIO = do openFilesIO : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: openFilesIO : '{IO} [Result] -.> io.test openFilesIO +scratch/main> io.test openFilesIO New test results: - ◉ openFilesIO Passed + 1. openFilesIO ◉ Passed ✅ 1 test(s) passing - Tip: Use view openFilesIO to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ## Universal hash functions Just exercises the function -```unison +``` unison > Universal.murmurHash 1 test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -534,41 +536,41 @@ test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Unive Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. -```ucm -.> test +``` ucm +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ Any.test1 Passed - ◉ Any.test2 Passed - ◉ Boolean.tests.andTable Passed - ◉ Boolean.tests.notTable Passed - ◉ Boolean.tests.orTable Passed - ◉ Bytes.tests.at Passed - ◉ Bytes.tests.compression Passed - ◉ Bytes.tests.fromBase64UrlUnpadded Passed - ◉ Bytes.tests.indexOf Passed - ◉ Int.tests.arithmetic Passed - ◉ Int.tests.bitTwiddling Passed - ◉ Int.tests.conversions Passed - ◉ Nat.tests.arithmetic Passed - ◉ Nat.tests.bitTwiddling Passed - ◉ Nat.tests.conversions Passed - ◉ Sandbox.test1 Passed - ◉ Sandbox.test2 Passed - ◉ Sandbox.test3 Passed - ◉ test.rtjqan7bcs Passed - ◉ Text.tests.alignment Passed - ◉ Text.tests.indexOf Passed - ◉ Text.tests.indexOfEmoji Passed - ◉ Text.tests.literalsEq Passed - ◉ Text.tests.patterns Passed - ◉ Text.tests.repeat Passed - ◉ Text.tests.takeDropAppend Passed - ◉ Universal.murmurHash.tests Passed + 1. Any.test1 ◉ Passed + 2. Any.test2 ◉ Passed + 3. Boolean.tests.andTable ◉ Passed + 4. Boolean.tests.notTable ◉ Passed + 5. Boolean.tests.orTable ◉ Passed + 6. Bytes.tests.at ◉ Passed + 7. Bytes.tests.compression ◉ Passed + 8. Bytes.tests.fromBase64UrlUnpadded ◉ Passed + 9. Bytes.tests.indexOf ◉ Passed + 10. Int.tests.arithmetic ◉ Passed + 11. Int.tests.bitTwiddling ◉ Passed + 12. Int.tests.conversions ◉ Passed + 13. Nat.tests.arithmetic ◉ Passed + 14. Nat.tests.bitTwiddling ◉ Passed + 15. Nat.tests.conversions ◉ Passed + 16. Sandbox.test1 ◉ Passed + 17. Sandbox.test2 ◉ Passed + 18. Sandbox.test3 ◉ Passed + 19. test.rtjqan7bcs ◉ Passed + 20. Text.tests.alignment ◉ Passed + 21. Text.tests.indexOf ◉ Passed + 22. Text.tests.indexOfEmoji ◉ Passed + 23. Text.tests.literalsEq ◉ Passed + 24. Text.tests.patterns ◉ Passed + 25. Text.tests.repeat ◉ Passed + 26. Text.tests.takeDropAppend ◉ Passed + 27. Universal.murmurHash.tests ◉ Passed ✅ 27 test(s) passing - Tip: Use view Any.test1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/bytesFromList.md b/unison-src/transcripts/bytesFromList.md index 9da15329f3..1abb998791 100644 --- a/unison-src/transcripts/bytesFromList.md +++ b/unison-src/transcripts/bytesFromList.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2,3,4]`: diff --git a/unison-src/transcripts/bytesFromList.output.md b/unison-src/transcripts/bytesFromList.output.md index 7d28cfc07a..b4a9782215 100644 --- a/unison-src/transcripts/bytesFromList.output.md +++ b/unison-src/transcripts/bytesFromList.output.md @@ -1,11 +1,10 @@ - This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2,3,4]`: -```unison +``` unison > Bytes.fromList [1,2,3,4] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/check763.md b/unison-src/transcripts/check763.md index 3bb162b344..8b32045144 100644 --- a/unison-src/transcripts/check763.md +++ b/unison-src/transcripts/check763.md @@ -1,7 +1,7 @@ Regression test for https://github.com/unisonweb/unison/issues/763 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,8 +10,8 @@ Regression test for https://github.com/unisonweb/unison/issues/763 ``` ```ucm -.> add -.> move.term +-+ boppitybeep -.> move.term boppitybeep +-+ +scratch/main> add +scratch/main> move.term +-+ boppitybeep +scratch/main> move.term boppitybeep +-+ ``` diff --git a/unison-src/transcripts/check763.output.md b/unison-src/transcripts/check763.output.md index b8421509d9..7975553f1d 100644 --- a/unison-src/transcripts/check763.output.md +++ b/unison-src/transcripts/check763.output.md @@ -1,11 +1,11 @@ Regression test for https://github.com/unisonweb/unison/issues/763 -```unison +``` unison (+-+) : Nat -> Nat -> Nat (+-+) x y = x * y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,18 +18,18 @@ Regression test for https://github.com/unisonweb/unison/issues/763 +-+ : Nat -> Nat -> Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: +-+ : Nat -> Nat -> Nat -.> move.term +-+ boppitybeep +scratch/main> move.term +-+ boppitybeep Done. -.> move.term boppitybeep +-+ +scratch/main> move.term boppitybeep +-+ Done. diff --git a/unison-src/transcripts/check873.md b/unison-src/transcripts/check873.md index 7145186286..b70937821d 100644 --- a/unison-src/transcripts/check873.md +++ b/unison-src/transcripts/check873.md @@ -1,7 +1,7 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point being, this shouldn't crash the runtime. :) ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -9,7 +9,7 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point bei ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/check873.output.md b/unison-src/transcripts/check873.output.md index 289c592f30..fa6f046e80 100644 --- a/unison-src/transcripts/check873.output.md +++ b/unison-src/transcripts/check873.output.md @@ -1,10 +1,10 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point being, this shouldn't crash the runtime. :) -```unison +``` unison (-) = builtin.Nat.sub ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,19 +17,19 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point bei - : Nat -> Nat -> Int ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - : Nat -> Nat -> Int ``` -```unison +``` unison baz x = x - 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/child-namespace-history-merge.md b/unison-src/transcripts/child-namespace-history-merge.md deleted file mode 100644 index 6ed0e2400e..0000000000 --- a/unison-src/transcripts/child-namespace-history-merge.md +++ /dev/null @@ -1,99 +0,0 @@ -# Behaviour of namespace histories during a merge. - -Note: This is a descriptive test meant to capture the current behaviour of -branch histories during a merge. -It isn't prescriptive about how merges _should_ work with respect to child branches, -but I think we should at least notice if we change things by accident. - - -## Setting up some history - -```ucm:hide -.> builtins.merge -``` - -```unison:hide -parent.top = "top" -parent.child.thing = "parent.child.thing" -``` - -The child branch has a single history node representing the addition of `parent.child.thing`. - -```ucm -.> add -.> history parent.child -``` - -If we add another thing to the child namespace it should add another history node to both the child and parent. - -```unison:hide -parent.child.thing2 = "parent.child.thing2" -``` - -```ucm -.> add -.> history parent -.> history parent.child -``` - -## Forking off some history on a separate branch - -Now we fork the parent namespace to make some changes. - -```ucm -.> fork parent parent_fork -``` - -```unison:hide -parent_fork.child.thing3 = "parent_fork.child.thing3" -``` - -The child should have a new history node after adding `thing3` - -```ucm -.> add -.> history parent_fork.child -``` - -## Saving our parent state - -Split off two separate forks, one for testing squash merges, one for standard merges. - -```ucm:hide -.> fork parent parent_squash_base -.> fork parent parent_merge_base -``` - -## Squash merge - -For a squash merge, when I squash-merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old.squash parent_fork parent_squash_base -.> history parent_squash_base -``` - -Notice that with the current behaviour, the history of `parent.child` is completely wiped out, containing nothing from the source OR destination. - -```ucm -.> history parent.child -.> history parent_fork.child -.> history parent_squash_base.child -``` - -## Standard merge - -For a standard merge, if I merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old parent_fork parent_merge_base -.> history parent_merge_base -``` - -Child histories should also be *merged*. - -```ucm -.> history parent.child -.> history parent_fork.child -.> history parent_merge_base.child -``` diff --git a/unison-src/transcripts/child-namespace-history-merge.output.md b/unison-src/transcripts/child-namespace-history-merge.output.md deleted file mode 100644 index 18e080e093..0000000000 --- a/unison-src/transcripts/child-namespace-history-merge.output.md +++ /dev/null @@ -1,302 +0,0 @@ -# Behaviour of namespace histories during a merge. - -Note: This is a descriptive test meant to capture the current behaviour of -branch histories during a merge. -It isn't prescriptive about how merges _should_ work with respect to child branches, -but I think we should at least notice if we change things by accident. - - -## Setting up some history - -```unison -parent.top = "top" -parent.child.thing = "parent.child.thing" -``` - -The child branch has a single history node representing the addition of `parent.child.thing`. - -```ucm -.> add - - ⍟ I've added these definitions: - - parent.child.thing : Text - parent.top : Text - -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #0r73mam57g (start of history) - -``` -If we add another thing to the child namespace it should add another history node to both the child and parent. - -```unison -parent.child.thing2 = "parent.child.thing2" -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - parent.child.thing2 : Text - -.> history parent - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #2hv7t9lp40 - - + Adds / updates: - - child.thing2 - - □ 2. #i9lji1bli0 (start of history) - -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 2. #0r73mam57g (start of history) - -``` -## Forking off some history on a separate branch - -Now we fork the parent namespace to make some changes. - -```ucm -.> fork parent parent_fork - - Done. - -``` -```unison -parent_fork.child.thing3 = "parent_fork.child.thing3" -``` - -The child should have a new history node after adding `thing3` - -```ucm -.> add - - ⍟ I've added these definitions: - - parent_fork.child.thing3 : Text - -.> history parent_fork.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -``` -## Saving our parent state - -Split off two separate forks, one for testing squash merges, one for standard merges. - -## Squash merge - -For a squash merge, when I squash-merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old.squash parent_fork parent_squash_base - - Here's what's changed in parent_squash_base after the merge: - - Added definitions: - - 1. child.thing3 : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history parent_squash_base - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #594e0e1p39 - - + Adds / updates: - - child.thing3 - - ⊙ 2. #2hv7t9lp40 - - + Adds / updates: - - child.thing2 - - □ 3. #i9lji1bli0 (start of history) - -``` -Notice that with the current behaviour, the history of `parent.child` is completely wiped out, containing nothing from the source OR destination. - -```ucm -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 2. #0r73mam57g (start of history) - -.> history parent_fork.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -.> history parent_squash_base.child - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #19fd4mhpp4 (start of history) - -``` -## Standard merge - -For a standard merge, if I merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old parent_fork parent_merge_base - - Here's what's changed in parent_merge_base after the merge: - - Added definitions: - - 1. child.thing3 : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history parent_merge_base - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #mtn8sha7gd - - + Adds / updates: - - child.thing3 - - ⊙ 2. #2hv7t9lp40 - - + Adds / updates: - - child.thing2 - - □ 3. #i9lji1bli0 (start of history) - -``` -Child histories should also be *merged*. - -```ucm -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 2. #0r73mam57g (start of history) - -.> history parent_fork.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -.> history parent_merge_base.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -``` diff --git a/unison-src/transcripts/constructor-applied-to-unit.md b/unison-src/transcripts/constructor-applied-to-unit.md index df1341aa5c..fc598a883f 100644 --- a/unison-src/transcripts/constructor-applied-to-unit.md +++ b/unison-src/transcripts/constructor-applied-to-unit.md @@ -1,6 +1,6 @@ ```ucm:hide -.> alias.type ##Nat Nat -.> alias.term ##Any.Any Any +scratch/main> alias.type ##Nat Nat +scratch/main> alias.term ##Any.Any Any ``` ```unison diff --git a/unison-src/transcripts/constructor-applied-to-unit.output.md b/unison-src/transcripts/constructor-applied-to-unit.output.md index 4acfdcd865..e12d3f1d43 100644 --- a/unison-src/transcripts/constructor-applied-to-unit.output.md +++ b/unison-src/transcripts/constructor-applied-to-unit.output.md @@ -1,11 +1,11 @@ -```unison +``` unison structural type Zoink a b c = Zoink a b c > Any () > [ Zoink [0,1,2,3,4,5] [6,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,3] () ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/contrabilities.md b/unison-src/transcripts/contrabilities.md index 795ec15566..5d1fdcb647 100644 --- a/unison-src/transcripts/contrabilities.md +++ b/unison-src/transcripts/contrabilities.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/contrabilities.output.md b/unison-src/transcripts/contrabilities.output.md index d8c725660c..ef0f98dffa 100644 --- a/unison-src/transcripts/contrabilities.output.md +++ b/unison-src/transcripts/contrabilities.output.md @@ -1,9 +1,9 @@ -```unison +``` unison f : (() -> a) -> Nat f x = 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/create-author.md b/unison-src/transcripts/create-author.md index d9a39c735f..af06558660 100644 --- a/unison-src/transcripts/create-author.md +++ b/unison-src/transcripts/create-author.md @@ -1,10 +1,10 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` Demonstrating `create.author`: ```ucm -.foo> create.author alicecoder "Alice McGee" -.foo> view 2 +scratch/main> create.author alicecoder "Alice McGee" +scratch/main> find alicecoder ``` diff --git a/unison-src/transcripts/create-author.output.md b/unison-src/transcripts/create-author.output.md index 3a5635947b..caa4d2740d 100644 --- a/unison-src/transcripts/create-author.output.md +++ b/unison-src/transcripts/create-author.output.md @@ -1,22 +1,21 @@ Demonstrating `create.author`: -```ucm - ☝️ The namespace .foo is empty. - -.foo> create.author alicecoder "Alice McGee" +``` ucm +scratch/main> create.author alicecoder "Alice McGee" Added definitions: - 1. metadata.authors.alicecoder : #345f3nptqq - 2. metadata.copyrightHolders.alicecoder : #pgornst1pq - 3. metadata.authors.alicecoder.guid : #hqectlr3gt + 1. metadata.authors.alicecoder : Author + 2. metadata.copyrightHolders.alicecoder : CopyrightHolder + 3. metadata.authors.alicecoder.guid : GUID Tip: Add License values for alicecoder under metadata. -.foo> view 2 +scratch/main> find alicecoder - .foo.metadata.copyrightHolders.alicecoder : CopyrightHolder - .foo.metadata.copyrightHolders.alicecoder = - CopyrightHolder alicecoder.guid "Alice McGee" + 1. metadata.authors.alicecoder : Author + 2. metadata.copyrightHolders.alicecoder : CopyrightHolder + 3. metadata.authors.alicecoder.guid : GUID + ``` diff --git a/unison-src/transcripts/cycle-update-1.md b/unison-src/transcripts/cycle-update-1.md index 5294f2e49b..b60bc763e4 100644 --- a/unison-src/transcripts/cycle-update-1.md +++ b/unison-src/transcripts/cycle-update-1.md @@ -1,7 +1,7 @@ Update a member of a cycle, but retain the cycle. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,6 +22,6 @@ ping _ = !pong + 3 ``` ```ucm -.> update -.> view ping pong +scratch/main> update +scratch/main> view ping pong ``` diff --git a/unison-src/transcripts/cycle-update-1.output.md b/unison-src/transcripts/cycle-update-1.output.md index 3906248333..b5dd6e69aa 100644 --- a/unison-src/transcripts/cycle-update-1.output.md +++ b/unison-src/transcripts/cycle-update-1.output.md @@ -1,6 +1,6 @@ Update a member of a cycle, but retain the cycle. -```unison +``` unison ping : 'Nat ping _ = !pong + 1 @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,8 +22,8 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -31,12 +31,12 @@ pong _ = !ping + 2 pong : 'Nat ``` -```unison +``` unison ping : 'Nat ping _ = !pong + 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,8 +50,8 @@ ping _ = !pong + 3 ping : 'Nat ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -62,16 +62,16 @@ ping _ = !pong + 3 Done. -.> view ping pong +scratch/main> view ping pong ping : 'Nat ping _ = use Nat + - !pong + 3 + pong() + 3 pong : 'Nat pong _ = use Nat + - !ping + 2 + ping() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-2.md b/unison-src/transcripts/cycle-update-2.md index bd8c6edc13..0feb63afc2 100644 --- a/unison-src/transcripts/cycle-update-2.md +++ b/unison-src/transcripts/cycle-update-2.md @@ -1,7 +1,7 @@ Update a member of a cycle with a type-preserving update, but sever the cycle. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,6 +22,6 @@ ping _ = 3 ``` ```ucm -.> update -.> view ping pong +scratch/main> update +scratch/main> view ping pong ``` diff --git a/unison-src/transcripts/cycle-update-2.output.md b/unison-src/transcripts/cycle-update-2.output.md index 6884788130..b9bdc363fd 100644 --- a/unison-src/transcripts/cycle-update-2.output.md +++ b/unison-src/transcripts/cycle-update-2.output.md @@ -1,6 +1,6 @@ Update a member of a cycle with a type-preserving update, but sever the cycle. -```unison +``` unison ping : 'Nat ping _ = !pong + 1 @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,8 +22,8 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -31,12 +31,12 @@ pong _ = !ping + 2 pong : 'Nat ``` -```unison +``` unison ping : 'Nat ping _ = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,8 +50,8 @@ ping _ = 3 ping : 'Nat ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -62,7 +62,7 @@ ping _ = 3 Done. -.> view ping pong +scratch/main> view ping pong ping : 'Nat ping _ = 3 @@ -70,6 +70,6 @@ ping _ = 3 pong : 'Nat pong _ = use Nat + - !ping + 2 + ping() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-3.md b/unison-src/transcripts/cycle-update-3.md index dfcd87305e..b5e1e05551 100644 --- a/unison-src/transcripts/cycle-update-3.md +++ b/unison-src/transcripts/cycle-update-3.md @@ -1,7 +1,7 @@ Update a member of a cycle with a type-changing update, thus severing the cycle. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,6 +22,6 @@ ping = 3 ``` ```ucm -.> update.old -.> view ping pong +scratch/main> update.old +scratch/main> view ping pong ``` diff --git a/unison-src/transcripts/cycle-update-3.output.md b/unison-src/transcripts/cycle-update-3.output.md index 7a0a499dbc..15b0e26624 100644 --- a/unison-src/transcripts/cycle-update-3.output.md +++ b/unison-src/transcripts/cycle-update-3.output.md @@ -1,6 +1,6 @@ Update a member of a cycle with a type-changing update, thus severing the cycle. -```unison +``` unison ping : 'Nat ping _ = !pong + 1 @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,8 +22,8 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -31,12 +31,12 @@ pong _ = !ping + 2 pong : 'Nat ``` -```unison +``` unison ping : Nat ping = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,14 +50,14 @@ ping = 3 ping : Nat ``` -```ucm -.> update.old +``` ucm +scratch/main> update.old ⍟ I've updated these names to your new definition: ping : Nat -.> view ping pong +scratch/main> view ping pong ping : Nat ping = 3 @@ -65,6 +65,6 @@ ping = 3 pong : 'Nat pong _ = use Nat + - !#4t465jk908.1 + 2 + #4t465jk908.1() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-4.md b/unison-src/transcripts/cycle-update-4.md index d2bf98f690..ae389489b9 100644 --- a/unison-src/transcripts/cycle-update-4.md +++ b/unison-src/transcripts/cycle-update-4.md @@ -1,7 +1,7 @@ `update` properly discovers and establishes new cycles. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -25,6 +25,6 @@ clang _ = !pong + 3 ``` ```ucm -.> update.old ping -.> view ping pong clang +scratch/main> update.old ping +scratch/main> view ping pong clang ``` diff --git a/unison-src/transcripts/cycle-update-4.output.md b/unison-src/transcripts/cycle-update-4.output.md index fd525176bf..2fec74ba80 100644 --- a/unison-src/transcripts/cycle-update-4.output.md +++ b/unison-src/transcripts/cycle-update-4.output.md @@ -1,6 +1,6 @@ `update` properly discovers and establishes new cycles. -```unison +``` unison ping : 'Nat ping _ = 1 @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,8 +22,8 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ pong _ = !ping + 2 pong : 'Nat ``` -```unison +``` unison ping : 'Nat ping _ = !clang + 1 @@ -39,7 +39,7 @@ clang : 'Nat clang _ = !pong + 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -57,8 +57,8 @@ clang _ = !pong + 3 ping : 'Nat ``` -```ucm -.> update.old ping +``` ucm +scratch/main> update.old ping ⍟ I've added these definitions: @@ -69,21 +69,21 @@ clang _ = !pong + 3 ping : 'Nat pong : 'Nat -.> view ping pong clang +scratch/main> view ping pong clang clang : 'Nat clang _ = use Nat + - !pong + 3 + pong() + 3 ping : 'Nat ping _ = use Nat + - !clang + 1 + clang() + 1 pong : 'Nat pong _ = use Nat + - !ping + 2 + ping() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-5.md b/unison-src/transcripts/cycle-update-5.md deleted file mode 100644 index c09a93c3d7..0000000000 --- a/unison-src/transcripts/cycle-update-5.md +++ /dev/null @@ -1,34 +0,0 @@ -Not yet working: properly updating nameless implicit terms. - -```ucm:hide -.> builtins.merge -``` - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 1 - -pong : 'Nat -pong _ = !inner.ping + 2 -``` - -```ucm -.> add -``` - -Here we queue up an update by saving in a namespace where `inner.ping` and `pong` both have names, but then apply the -update in a namespace where only `ping` has a name. - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 3 -``` - -```ucm -.inner> update.old -.> view inner.ping -``` - -The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the -context that the update was applied) `pong` as an implicit term to include in the new `ping`'s cycle, then `ping` would -be left referring to a nameless thing (namely, `pong`, but updated to refer to the new `ping`). diff --git a/unison-src/transcripts/cycle-update-5.output.md b/unison-src/transcripts/cycle-update-5.output.md deleted file mode 100644 index 3e3361f70c..0000000000 --- a/unison-src/transcripts/cycle-update-5.output.md +++ /dev/null @@ -1,73 +0,0 @@ -Not yet working: properly updating nameless implicit terms. - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 1 - -pong : 'Nat -pong _ = !inner.ping + 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - inner.ping : 'Nat - pong : 'Nat - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - inner.ping : 'Nat - pong : 'Nat - -``` -Here we queue up an update by saving in a namespace where `inner.ping` and `pong` both have names, but then apply the -update in a namespace where only `ping` has a name. - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 3 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - inner.ping : 'Nat - -``` -```ucm -.inner> update.old - - ⍟ I've added these definitions: - - inner.ping : '##Nat - -.> view inner.ping - - inner.ping : 'Nat - inner.ping _ = - use Nat + - !pong + 1 - -``` -The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the -context that the update was applied) `pong` as an implicit term to include in the new `ping`'s cycle, then `ping` would -be left referring to a nameless thing (namely, `pong`, but updated to refer to the new `ping). diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md index 4717486917..0d10165f54 100644 --- a/unison-src/transcripts/debug-definitions.md +++ b/unison-src/transcripts/debug-definitions.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -17,12 +17,12 @@ ability Ask a where ``` ```ucm -.> add -.> debug.term.abt Nat.+ -.> debug.term.abt y -.> debug.term.abt Some -.> debug.term.abt ask -.> debug.type.abt Nat -.> debug.type.abt Optional -.> debug.type.abt Ask +scratch/main> add +scratch/main> debug.term.abt Nat.+ +scratch/main> debug.term.abt y +scratch/main> debug.term.abt Some +scratch/main> debug.term.abt ask +scratch/main> debug.type.abt Nat +scratch/main> debug.type.abt Optional +scratch/main> debug.type.abt Ask ``` diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md index cb1b14d1a2..9c4bb349c5 100644 --- a/unison-src/transcripts/debug-definitions.output.md +++ b/unison-src/transcripts/debug-definitions.output.md @@ -1,4 +1,4 @@ -```unison +``` unison x = 30 y : Nat @@ -12,8 +12,8 @@ ability Ask a where ask : a ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -23,15 +23,15 @@ ability Ask a where x : Nat y : Nat -.> debug.term.abt Nat.+ +scratch/main> debug.term.abt Nat.+ Builtin term: ##Nat.+ -.> debug.term.abt y +scratch/main> debug.term.abt y (let Ref(ReferenceBuiltin "Nat.+") Ref(ReferenceDerived (Id "qpo3o788girkkbb43uf6ggqberfduhtnqbt7096eojlrp27jieco09mdasb7b0b06ej9hj60a00nnbbdo8he0b4e0m7vtopifiuhdig" 0)) 2 in (User "z". Ref(ReferenceBuiltin "Nat.+") (Var User "z") 10)):ReferenceBuiltin "Nat" -.> debug.term.abt Some +scratch/main> debug.term.abt Some Constructor #0 of the following type: DataDeclaration @@ -61,7 +61,7 @@ ability Ask a where ] } -.> debug.term.abt ask +scratch/main> debug.term.abt ask Constructor #0 of the following type: EffectDeclaration @@ -90,11 +90,11 @@ ability Ask a where } } -.> debug.type.abt Nat +scratch/main> debug.type.abt Nat Builtin type: ##Nat -.> debug.type.abt Optional +scratch/main> debug.type.abt Optional DataDeclaration { modifier = Structural @@ -123,7 +123,7 @@ ability Ask a where ] } -.> debug.type.abt Ask +scratch/main> debug.type.abt Ask EffectDeclaration { toDataDecl = DataDeclaration diff --git a/unison-src/transcripts/debug-name-diffs.md b/unison-src/transcripts/debug-name-diffs.md index 361142bf57..5d4970e599 100644 --- a/unison-src/transcripts/debug-name-diffs.md +++ b/unison-src/transcripts/debug-name-diffs.md @@ -10,10 +10,10 @@ structural type a.b.Baz = Boo ``` ```ucm -.> add -.> delete.term.verbose a.b.one -.> alias.term a.two a.newtwo -.> move.namespace a.x a.y -.> history -.> debug.name-diff 4 1 +scratch/main> add +scratch/main> delete.term.verbose a.b.one +scratch/main> alias.term a.two a.newtwo +scratch/main> move.namespace a.x a.y +scratch/main> history +scratch/main> debug.name-diff 4 1 ``` diff --git a/unison-src/transcripts/debug-name-diffs.output.md b/unison-src/transcripts/debug-name-diffs.output.md index ac6895c14e..9033106895 100644 --- a/unison-src/transcripts/debug-name-diffs.output.md +++ b/unison-src/transcripts/debug-name-diffs.output.md @@ -1,4 +1,4 @@ -```unison +``` unison a.b.one = 1 a.two = 2 @@ -9,7 +9,7 @@ structural type a.x.Foo = Foo | Bar structural type a.b.Baz = Boo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,8 +27,8 @@ structural type a.b.Baz = Boo a.x.three : ##Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -39,23 +39,24 @@ structural type a.b.Baz = Boo a.x.four : ##Nat a.x.three : ##Nat -.> delete.term.verbose a.b.one +scratch/main> delete.term.verbose a.b.one Removed definitions: 1. a.b.one : ##Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -.> alias.term a.two a.newtwo +scratch/main> alias.term a.two a.newtwo Done. -.> move.namespace a.x a.y +scratch/main> move.namespace a.x a.y Done. -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. @@ -90,7 +91,7 @@ structural type a.b.Baz = Boo □ 4. #gss5s88mo3 (start of history) -.> debug.name-diff 4 1 +scratch/main> debug.name-diff 4 1 Kind Name Change Ref Term a.newtwo Added #dcgdua2lj6upd1ah5v0qp09gjsej0d77d87fu6qn8e2qrssnlnmuinoio46hiu53magr7qn8vnqke8ndt0v76700o5u8gcvo7st28jg diff --git a/unison-src/transcripts/deep-names.md b/unison-src/transcripts/deep-names.md index 3487497cc3..9d6695bc47 100644 --- a/unison-src/transcripts/deep-names.md +++ b/unison-src/transcripts/deep-names.md @@ -12,36 +12,42 @@ http.z = 8 ``` ```ucm:hide -.> add +scratch/main> add +scratch/main> branch /app1 +scratch/main> branch /app2 ``` Our `app1` project includes the text library twice and the http library twice as direct dependencies. ```ucm -.app1> fork .text lib.text_v1 -.app1> fork .text lib.text_v2 -.app1> fork .http lib.http_v3 -.app1> fork .http lib.http_v4 +scratch/app1> fork text lib.text_v1 +scratch/app1> fork text lib.text_v2 +scratch/app1> delete.namespace text +scratch/app1> fork http lib.http_v3 +scratch/app1> fork http lib.http_v4 +scratch/app1> delete.namespace http ``` As such, we see two copies of `a` and two copies of `x` via these direct dependencies. ```ucm -.app1> names a -.app1> names x +scratch/app1> names a +scratch/app1> names x ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. It also includes the `text` library twice as indirect dependencies via `webutil` ```ucm -.app2> fork .http lib.http_v1 -.app2> fork .http lib.http_v2 -.app2> fork .text lib.webutil.lib.text_v1 -.app2> fork .text lib.webutil.lib.text_v2 -.app2> fork .http lib.webutil.lib.http +scratch/app2> fork http lib.http_v1 +scratch/app2> fork http lib.http_v2 +scratch/app2> fork text lib.webutil.lib.text_v1 +scratch/app2> fork text lib.webutil.lib.text_v2 +scratch/app2> fork http lib.webutil.lib.http +scratch/app2> delete.namespace http +scratch/app2> delete.namespace text ``` Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. ```ucm -.app2> names a -.app2> names x +scratch/app2> names a +scratch/app2> names x ``` diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md index 3b6637d8a7..114133d786 100644 --- a/unison-src/transcripts/deep-names.output.md +++ b/unison-src/transcripts/deep-names.output.md @@ -1,7 +1,8 @@ First we'll set up two libraries, and then we'll use them in some projects and show what `names` are deep-loaded for them. Our two "libraries": -```unison + +``` unison text.a = 1 text.b = 2 text.c = 3 @@ -12,29 +13,37 @@ http.z = 8 ``` Our `app1` project includes the text library twice and the http library twice as direct dependencies. -```ucm - ☝️ The namespace .app1 is empty. -.app1> fork .text lib.text_v1 +``` ucm +scratch/app1> fork text lib.text_v1 + + Done. + +scratch/app1> fork text lib.text_v2 Done. -.app1> fork .text lib.text_v2 +scratch/app1> delete.namespace text Done. -.app1> fork .http lib.http_v3 +scratch/app1> fork http lib.http_v3 Done. -.app1> fork .http lib.http_v4 +scratch/app1> fork http lib.http_v4 + + Done. + +scratch/app1> delete.namespace http Done. ``` As such, we see two copies of `a` and two copies of `x` via these direct dependencies. -```ucm -.app1> names a + +``` ucm +scratch/app1> names a Term Hash: #gjmq673r1v @@ -42,7 +51,7 @@ As such, we see two copies of `a` and two copies of `x` via these direct depende Tip: Use `names.global` to see more results. -.app1> names x +scratch/app1> names x Term Hash: #nsmc4p1ra4 @@ -53,34 +62,42 @@ As such, we see two copies of `a` and two copies of `x` via these direct depende ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. It also includes the `text` library twice as indirect dependencies via `webutil` -```ucm - ☝️ The namespace .app2 is empty. -.app2> fork .http lib.http_v1 +``` ucm +scratch/app2> fork http lib.http_v1 Done. -.app2> fork .http lib.http_v2 +scratch/app2> fork http lib.http_v2 Done. -.app2> fork .text lib.webutil.lib.text_v1 +scratch/app2> fork text lib.webutil.lib.text_v1 Done. -.app2> fork .text lib.webutil.lib.text_v2 +scratch/app2> fork text lib.webutil.lib.text_v2 Done. -.app2> fork .http lib.webutil.lib.http +scratch/app2> fork http lib.webutil.lib.http + + Done. + +scratch/app2> delete.namespace http + + Done. + +scratch/app2> delete.namespace text Done. ``` Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. -```ucm -.app2> names a + +``` ucm +scratch/app2> names a Term Hash: #gjmq673r1v @@ -88,7 +105,7 @@ We see neither the second indirect copy of `a` nor the indirect copy of `x` via Tip: Use `names.global` to see more results. -.app2> names x +scratch/app2> names x Term Hash: #nsmc4p1ra4 diff --git a/unison-src/transcripts/definition-diff-api.output.md b/unison-src/transcripts/definition-diff-api.output.md index 192367ff9f..1670f2b05d 100644 --- a/unison-src/transcripts/definition-diff-api.output.md +++ b/unison-src/transcripts/definition-diff-api.output.md @@ -1,10 +1,10 @@ -```ucm +``` ucm diffs/main> builtins.merge Done. ``` -```unison +``` unison term = _ = "Here's some text" 1 + 1 @@ -12,7 +12,7 @@ term = type Type = Type Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ type Type = Type Nat term : Nat ``` -```ucm +``` ucm diffs/main> add ⍟ I've added these definitions: @@ -42,7 +42,7 @@ diffs/main> branch.create new `switch /main` then `merge /new`. ``` -```unison +``` unison term = _ = "Here's some different text" 1 + 2 @@ -50,7 +50,7 @@ term = type Type a = Type a Text ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -65,7 +65,7 @@ type Type a = Type a Text term : Nat ``` -```ucm +``` ucm diffs/new> update Okay, I'm searching the branch for code that needs to be @@ -76,7 +76,7 @@ diffs/new> update ``` Diff terms -```api +``` api GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=term&newTerm=term { "diff": { @@ -558,9 +558,11 @@ GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=te }, "project": "diffs" } -```Diff types +``` + +Diff types -```api +``` api GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Type&newType=Type { "diff": { @@ -804,4 +806,5 @@ GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Ty }, "project": "diffs" } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/delete-namespace-dependents-check.output.md b/unison-src/transcripts/delete-namespace-dependents-check.output.md index 4ab6524093..1343731033 100644 --- a/unison-src/transcripts/delete-namespace-dependents-check.output.md +++ b/unison-src/transcripts/delete-namespace-dependents-check.output.md @@ -2,15 +2,15 @@ # Delete namespace dependents check -This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name _anywhere_ in your codebase, it should only check the current project branch. +This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name *anywhere* in your codebase, it should only check the current project branch. -```unison +``` unison sub.dependency = 123 dependent = dependency + 99 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ dependent = dependency + 99 sub.dependency : Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/delete-namespace.md b/unison-src/transcripts/delete-namespace.md index fe8f346306..5bbdda79e6 100644 --- a/unison-src/transcripts/delete-namespace.md +++ b/unison-src/transcripts/delete-namespace.md @@ -1,7 +1,7 @@ # delete.namespace.force ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -15,47 +15,47 @@ dependents.usage2 = dependencies.term1 * dependencies.term2 ``` ```ucm:hide -.> add +scratch/main> add ``` Deleting a namespace with no external dependencies should succeed. ```ucm -.> delete.namespace no_dependencies +scratch/main> delete.namespace no_dependencies ``` Deleting a namespace with external dependencies should fail and list all dependents. ```ucm:error -.> delete.namespace dependencies +scratch/main> delete.namespace dependencies ``` Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` ```ucm -.> delete.namespace.force dependencies +scratch/main> delete.namespace.force dependencies ``` I should be able to view an affected dependency by number ```ucm -.> view 2 +scratch/main> view 2 ``` Deleting the root namespace should require confirmation if not forced. ```ucm -.> delete.namespace . -.> delete.namespace . +scratch/main> delete.namespace . +scratch/main> delete.namespace . -- Should have an empty history -.> history . +scratch/main> history . ``` Deleting the root namespace shouldn't require confirmation if forced. ```ucm -.> delete.namespace.force . +scratch/main> delete.namespace.force . -- Should have an empty history -.> history . +scratch/main> history . ``` diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md index e7c09cbaed..ef7c2a5307 100644 --- a/unison-src/transcripts/delete-namespace.output.md +++ b/unison-src/transcripts/delete-namespace.output.md @@ -1,6 +1,6 @@ # delete.namespace.force -```unison +``` unison no_dependencies.thing = "no dependents on this term" dependencies.term1 = 1 @@ -12,16 +12,16 @@ dependents.usage2 = dependencies.term1 * dependencies.term2 Deleting a namespace with no external dependencies should succeed. -```ucm -.> delete.namespace no_dependencies +``` ucm +scratch/main> delete.namespace no_dependencies Done. ``` Deleting a namespace with external dependencies should fail and list all dependents. -```ucm -.> delete.namespace dependencies +``` ucm +scratch/main> delete.namespace dependencies ⚠️ @@ -41,8 +41,8 @@ Deleting a namespace with external dependencies should fail and list all depende ``` Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` -```ucm -.> delete.namespace.force dependencies +``` ucm +scratch/main> delete.namespace.force dependencies Done. @@ -61,8 +61,8 @@ Deleting a namespace with external dependencies should succeed when using `delet ``` I should be able to view an affected dependency by number -```ucm -.> view 2 +``` ucm +scratch/main> view 2 dependents.usage2 : Nat dependents.usage2 = @@ -72,38 +72,49 @@ I should be able to view an affected dependency by number ``` Deleting the root namespace should require confirmation if not forced. -```ucm -.> delete.namespace . +``` ucm +scratch/main> delete.namespace . ⚠️ Are you sure you want to clear away everything? - You could use `project.create` to switch to a new project instead. + You could use `project.create` to switch to a new project + instead, or delete the current branch with `delete.branch` -.> delete.namespace . +scratch/main> delete.namespace . Okay, I deleted everything except the history. Use `undo` to undo, or `builtins.merge` to restore the absolute basics to the current path. -- Should have an empty history -.> history . +scratch/main> history . - ☝️ The namespace . is empty. + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) ``` Deleting the root namespace shouldn't require confirmation if forced. -```ucm -.> delete.namespace.force . +``` ucm +scratch/main> delete.namespace.force . Okay, I deleted everything except the history. Use `undo` to undo, or `builtins.merge` to restore the absolute basics to the current path. -- Should have an empty history -.> history . +scratch/main> history . - ☝️ The namespace . is empty. + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) ``` diff --git a/unison-src/transcripts/delete-project-branch.md b/unison-src/transcripts/delete-project-branch.md index c84dc95cc2..923df54ba1 100644 --- a/unison-src/transcripts/delete-project-branch.md +++ b/unison-src/transcripts/delete-project-branch.md @@ -17,7 +17,7 @@ You can precede the branch name by a project name. ```ucm foo/main> branch topic -.> delete.branch foo/topic +scratch/main> delete.branch foo/topic ``` You can delete the only branch in a project. @@ -25,3 +25,18 @@ You can delete the only branch in a project. ```ucm foo/main> delete.branch /main ``` + +You can delete the last branch in the project, a new one will be created. + +```ucm +scratch/main> delete.branch scratch/main +scratch/main> branches +``` + +If the the last branch isn't /main, then /main will be created. + +```ucm +scratch/main2> delete.branch /main +scratch/main2> delete.branch /main2 +scratch/other> branches +``` diff --git a/unison-src/transcripts/delete-project-branch.output.md b/unison-src/transcripts/delete-project-branch.output.md index d4458e8be0..9423a7ed2c 100644 --- a/unison-src/transcripts/delete-project-branch.output.md +++ b/unison-src/transcripts/delete-project-branch.output.md @@ -1,7 +1,7 @@ Deleting the branch you are on takes you to its parent (though this is impossible to see in a transcript, since we set your working directory with each command). -```ucm +``` ucm foo/main> branch topic Done. I've created the topic branch based off of main. @@ -14,7 +14,7 @@ foo/topic> delete.branch /topic ``` A branch need not be preceded by a forward slash. -```ucm +``` ucm foo/main> branch topic Done. I've created the topic branch based off of main. @@ -27,7 +27,7 @@ foo/topic> delete.branch topic ``` You can precede the branch name by a project name. -```ucm +``` ucm foo/main> branch topic Done. I've created the topic branch based off of main. @@ -35,14 +35,38 @@ foo/main> branch topic Tip: To merge your work back into the main branch, first `switch /main` then `merge /topic`. - ☝️ The namespace . is empty. - -.> delete.branch foo/topic +scratch/main> delete.branch foo/topic ``` You can delete the only branch in a project. -```ucm +``` ucm foo/main> delete.branch /main ``` +You can delete the last branch in the project, a new one will be created. + +``` ucm +scratch/main> delete.branch scratch/main + +scratch/main> branches + + Branch Remote branch + 1. main + 2. main2 + +``` +If the the last branch isn't /main, then /main will be created. + +``` ucm +scratch/main2> delete.branch /main + +scratch/main2> delete.branch /main2 + +scratch/other> branches + + Branch Remote branch + 1. main + 2. other + +``` diff --git a/unison-src/transcripts/delete-project.md b/unison-src/transcripts/delete-project.md index df31873fb9..35774b7e81 100644 --- a/unison-src/transcripts/delete-project.md +++ b/unison-src/transcripts/delete-project.md @@ -1,9 +1,19 @@ # delete.project ```ucm -.> project.create-empty foo -.> project.create-empty bar -.> projects +scratch/main> project.create-empty foo +scratch/main> project.create-empty bar +-- I can delete the project I'm currently on +scratch/main> delete.project scratch +foo/main> projects +-- I can delete a different project +foo/main> delete.project bar +foo/main> projects +-- I can delete the last project, a new scratch project will be created foo/main> delete.project foo -.> projects +project/main> projects +-- If the last project is scratch, a scratch2 project will be created. +scratch/main> delete.project project +scratch/main> delete.project scratch +project/main> projects ``` diff --git a/unison-src/transcripts/delete-project.output.md b/unison-src/transcripts/delete-project.output.md index 18af51f9c0..37d8b2e350 100644 --- a/unison-src/transcripts/delete-project.output.md +++ b/unison-src/transcripts/delete-project.output.md @@ -1,7 +1,7 @@ # delete.project -```ucm -.> project.create-empty foo +``` ucm +scratch/main> project.create-empty foo 🎉 I've created the project foo. @@ -17,9 +17,7 @@ 🎉 🥳 Happy coding! - ☝️ The namespace . is empty. - -.> project.create-empty bar +scratch/main> project.create-empty bar 🎉 I've created the project bar. @@ -35,17 +33,37 @@ 🎉 🥳 Happy coding! - ☝️ The namespace . is empty. +-- I can delete the project I'm currently on +scratch/main> delete.project scratch -.> projects +foo/main> projects 1. bar 2. foo +-- I can delete a different project +foo/main> delete.project bar + +foo/main> projects + + 1. foo + +-- I can delete the last project, a new scratch project will be created foo/main> delete.project foo -.> projects +project/main> projects - 1. bar + 1. project + 2. scratch + +-- If the last project is scratch, a scratch2 project will be created. +scratch/main> delete.project project + +scratch/main> delete.project scratch + +project/main> projects + + 1. project + 2. scratch2 ``` diff --git a/unison-src/transcripts/delete-silent.md b/unison-src/transcripts/delete-silent.md index 33ec668de3..5a5037e9f1 100644 --- a/unison-src/transcripts/delete-silent.md +++ b/unison-src/transcripts/delete-silent.md @@ -1,5 +1,5 @@ ```ucm:error -.> delete foo +scratch/main> delete foo ``` ```unison:hide @@ -8,8 +8,8 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete foo -.> delete.type Foo -.> delete.term Foo.Foo +scratch/main> add +scratch/main> delete foo +scratch/main> delete.type Foo +scratch/main> delete.term Foo.Foo ``` diff --git a/unison-src/transcripts/delete-silent.output.md b/unison-src/transcripts/delete-silent.output.md index 7ea6d420d2..49c5a0860d 100644 --- a/unison-src/transcripts/delete-silent.output.md +++ b/unison-src/transcripts/delete-silent.output.md @@ -1,5 +1,5 @@ -```ucm -.> delete foo +``` ucm +scratch/main> delete foo ⚠️ @@ -7,28 +7,28 @@ foo ``` -```unison +``` unison foo = 1 structural type Foo = Foo () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: structural type Foo foo : ##Nat -.> delete foo +scratch/main> delete foo Done. -.> delete.type Foo +scratch/main> delete.type Foo Done. -.> delete.term Foo.Foo +scratch/main> delete.term Foo.Foo Done. diff --git a/unison-src/transcripts/delete.md b/unison-src/transcripts/delete.md index e3e27ede98..9c1b8efd1a 100644 --- a/unison-src/transcripts/delete.md +++ b/unison-src/transcripts/delete.md @@ -1,7 +1,7 @@ # Delete ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge lib.builtins ``` The delete command can delete both terms and types. @@ -10,7 +10,7 @@ First, let's make sure it complains when we try to delete a name that doesn't exist. ```ucm:error -.> delete.verbose foo +scratch/main> delete.verbose foo ``` Now for some easy cases. Deleting an unambiguous term, then deleting an @@ -22,66 +22,43 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete.verbose foo -.> delete.verbose Foo -.> delete.verbose Foo.Foo +scratch/main> add +scratch/main> delete.verbose foo +scratch/main> delete.verbose Foo +scratch/main> delete.verbose Foo.Foo ``` How about an ambiguous term? ```unison:hide -foo = 1 -``` - -```ucm -.a> add -``` - -```unison:hide -foo = 2 +a.foo = 1 +a.bar = 2 ``` ```ucm -.b> add -.a> merge.old .b +scratch/main> add +scratch/main> debug.alias.term.force a.bar a.foo ``` A delete should remove both versions of the term. ```ucm -.> delete.verbose a.foo -``` - -```ucm:error -.a> ls +scratch/main> delete.verbose a.foo +scratch/main> ls a ``` Let's repeat all that on a type, for completeness. ```unison:hide -structural type Foo = Foo () -``` - -```ucm -.a> add -``` - -```unison:hide -structural type Foo = Foo -``` - -```ucm -.b> add -.a> merge.old .b +structural type a.Foo = Foo () +structural type a.Bar = Bar ``` ```ucm -.> delete.verbose a.Foo -``` - -```ucm -.> delete.verbose a.Foo.Foo +scratch/main> add +scratch/main> debug.alias.type.force a.Bar a.Foo +scratch/main> delete.verbose a.Foo +scratch/main> delete.verbose a.Foo.Foo ``` Finally, let's try to delete a term and a type with the same name. @@ -92,11 +69,8 @@ structural type foo = Foo () ``` ```ucm -.> add -``` - -```ucm -.> delete.verbose foo +scratch/main> add +scratch/main> delete.verbose foo ``` We want to be able to delete multiple terms at once @@ -108,8 +82,8 @@ c = "c" ``` ```ucm -.> add -.> delete.verbose a b c +scratch/main> add +scratch/main> delete.verbose a b c ``` We can delete terms and types in the same invocation of delete @@ -122,9 +96,9 @@ c = "c" ``` ```ucm -.> add -.> delete.verbose a b c Foo -.> delete.verbose Foo.Foo +scratch/main> add +scratch/main> delete.verbose a b c Foo +scratch/main> delete.verbose Foo.Foo ``` We can delete a type and its constructors @@ -134,8 +108,8 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete.verbose Foo Foo.Foo +scratch/main> add +scratch/main> delete.verbose Foo Foo.Foo ``` You should not be able to delete terms which are referenced by other terms @@ -148,8 +122,8 @@ d = a + b + c ``` ```ucm:error -.> add -.> delete.verbose a b c +scratch/main> add +scratch/main> delete.verbose a b c ``` But you should be able to delete all terms which reference each other in a single command @@ -162,8 +136,8 @@ h = e + f + g ``` ```ucm -.> add -.> delete.verbose e f g h +scratch/main> add +scratch/main> delete.verbose e f g h ``` You should be able to delete a type and all the functions that reference it in a single command @@ -177,8 +151,8 @@ incrementFoo = cases ``` ```ucm -.> add -.> delete.verbose Foo Foo.Foo incrementFoo +scratch/main> add +scratch/main> delete.verbose Foo Foo.Foo incrementFoo ``` If you mess up on one of the names of your command, delete short circuits @@ -191,8 +165,8 @@ h = e + f + g ``` ```ucm:error -.> add -.> delete.verbose e f gg +scratch/main> add +scratch/main> delete.verbose e f gg ``` Cyclical terms which are guarded by a lambda are allowed to be deleted @@ -203,7 +177,7 @@ pong _ = 4 Nat.+ !ping ``` ```ucm -.> add -.> delete.verbose ping -.> view pong +scratch/main> add +scratch/main> delete.verbose ping +scratch/main> view pong ``` diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 05a998cc1e..c87f5140bd 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -5,8 +5,8 @@ The delete command can delete both terms and types. First, let's make sure it complains when we try to delete a name that doesn't exist. -```ucm -.> delete.verbose foo +``` ucm +scratch/main> delete.verbose foo ⚠️ @@ -17,97 +17,71 @@ exist. Now for some easy cases. Deleting an unambiguous term, then deleting an unambiguous type. -```unison +``` unison foo = 1 structural type Foo = Foo () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: structural type Foo foo : Nat -.> delete.verbose foo +scratch/main> delete.verbose foo Removed definitions: 1. foo : Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -.> delete.verbose Foo +scratch/main> delete.verbose Foo Removed definitions: 1. structural type Foo - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -.> delete.verbose Foo.Foo +scratch/main> delete.verbose Foo.Foo Removed definitions: 1. Foo.Foo : '#089vmor9c5 - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` How about an ambiguous term? -```unison -foo = 1 +``` unison +a.foo = 1 +a.bar = 2 ``` -```ucm - ☝️ The namespace .a is empty. - -.a> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - foo : ##Nat - -``` -```unison -foo = 2 -``` + a.bar : Nat + a.foo : Nat -```ucm - ☝️ The namespace .b is empty. +scratch/main> debug.alias.term.force a.bar a.foo -.b> add - - ⍟ I've added these definitions: - - foo : ##Nat - -.a> merge.old .b - - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. foo#gjmq673r1v : ##Nat - ↓ - 2. ┌ foo#dcgdua2lj6 : ##Nat - 3. └ foo#gjmq673r1v : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... + Done. ``` A delete should remove both versions of the term. -```ucm -.> delete.verbose a.foo +``` ucm +scratch/main> delete.verbose a.foo Removed definitions: @@ -116,72 +90,38 @@ A delete should remove both versions of the term. Name changes: Original Changes - 2. b.foo ┐ 3. a.foo#dcgdua2lj6 (removed) + 2. a.bar ┐ 3. a.foo#dcgdua2lj6 (removed) 4. a.foo#dcgdua2lj6 ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -``` -```ucm - ☝️ The namespace .a is empty. +scratch/main> ls a -.a> ls - - nothing to show + 1. bar (Nat) ``` Let's repeat all that on a type, for completeness. -```unison -structural type Foo = Foo () +``` unison +structural type a.Foo = Foo () +structural type a.Bar = Bar ``` -```ucm -.a> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - structural type Foo + structural type a.Bar + (also named lib.builtins.Unit) + structural type a.Foo -``` -```unison -structural type Foo = Foo -``` - -```ucm -.b> add - - ⍟ I've added these definitions: - - structural type Foo - -.a> merge.old .b - - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. structural type Foo#089vmor9c5 - ↓ - 2. ┌ structural type Foo#00nv2kob8f - 3. └ structural type Foo#089vmor9c5 - - 4. Foo.Foo#089vmor9c5#0 : 'Foo#089vmor9c5 - ↓ - 5. ┌ Foo.Foo#00nv2kob8f#0 : () - 6. └ Foo.Foo#089vmor9c5#0 : 'Foo#089vmor9c5 - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. +scratch/main> debug.alias.type.force a.Bar a.Foo - Applying changes from patch... + Done. -``` -```ucm -.> delete.verbose a.Foo +scratch/main> delete.verbose a.Foo Removed definitions: @@ -189,68 +129,60 @@ structural type Foo = Foo Name changes: - Original Changes - 2. b.Foo ┐ 3. a.Foo#00nv2kob8f (removed) - 4. builtin.Unit │ - 5. a.Foo#00nv2kob8f ┘ + Original Changes + 2. a.Bar ┐ 3. a.Foo#00nv2kob8f (removed) + 4. lib.builtins.Unit │ + 5. a.Foo#00nv2kob8f ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -``` -```ucm -.> delete.verbose a.Foo.Foo +scratch/main> delete.verbose a.Foo.Foo Removed definitions: - 1. a.Foo.Foo#089vmor9c5#0 : '#089vmor9c5 + 1. a.Foo.Foo : '#089vmor9c5 - Name changes: - - Original Changes - 2. b.Foo.Foo ┐ 3. a.Foo.Foo#00nv2kob8f#0 (removed) - 4. builtin.Unit.Unit │ - 5. a.Foo.Foo#00nv2kob8f#0 ┘ - - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` Finally, let's try to delete a term and a type with the same name. -```unison +``` unison foo = 1 structural type foo = Foo () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: structural type foo foo : Nat -``` -```ucm -.> delete.verbose foo +scratch/main> delete.verbose foo Removed definitions: 1. structural type foo 2. foo : Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` We want to be able to delete multiple terms at once -```unison +``` unison a = "a" b = "b" c = "c" ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -258,7 +190,7 @@ c = "c" b : Text c : Text -.> delete.verbose a b c +scratch/main> delete.verbose a b c Removed definitions: @@ -266,20 +198,21 @@ c = "c" 2. b : Text 3. c : Text - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` We can delete terms and types in the same invocation of delete -```unison +``` unison structural type Foo = Foo () a = "a" b = "b" c = "c" ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -288,7 +221,7 @@ c = "c" b : Text c : Text -.> delete.verbose a b c Foo +scratch/main> delete.verbose a b c Foo Removed definitions: @@ -297,9 +230,10 @@ c = "c" 3. b : Text 4. c : Text - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -.> delete.verbose Foo.Foo +scratch/main> delete.verbose Foo.Foo Name changes: @@ -307,23 +241,24 @@ c = "c" 1. Foo.Foo ┐ 2. Foo.Foo (removed) 3. foo.Foo ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` We can delete a type and its constructors -```unison +``` unison structural type Foo = Foo () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: structural type Foo -.> delete.verbose Foo Foo.Foo +scratch/main> delete.verbose Foo Foo.Foo Removed definitions: @@ -335,30 +270,31 @@ structural type Foo = Foo () 2. Foo.Foo ┐ 3. Foo.Foo (removed) 4. foo.Foo ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` You should not be able to delete terms which are referenced by other terms -```unison +``` unison a = 1 b = 2 c = 3 d = a + b + c ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: a : Nat b : Nat - (also named b.foo) + (also named a.bar) c : Nat d : Nat -.> delete.verbose a b c +scratch/main> delete.verbose a b c ⚠️ @@ -373,15 +309,15 @@ d = a + b + c ``` But you should be able to delete all terms which reference each other in a single command -```unison +``` unison e = 11 f = 12 + e g = 13 + f h = e + f + g ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -390,7 +326,7 @@ h = e + f + g g : Nat h : Nat -.> delete.verbose e f g h +scratch/main> delete.verbose e f g h Removed definitions: @@ -399,12 +335,13 @@ h = e + f + g 3. g : Nat 4. h : Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` You should be able to delete a type and all the functions that reference it in a single command -```unison +``` unison structural type Foo = Foo Nat incrementFoo : Foo -> Nat @@ -412,36 +349,37 @@ incrementFoo = cases (Foo n) -> n + 1 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: structural type Foo incrementFoo : Foo -> Nat -.> delete.verbose Foo Foo.Foo incrementFoo +scratch/main> delete.verbose Foo Foo.Foo incrementFoo Removed definitions: 1. structural type Foo - 2. Foo.Foo : Nat -> #68k40ra7l7 - 3. incrementFoo : #68k40ra7l7 -> Nat + 2. Foo.Foo : Nat -> Foo + 3. incrementFoo : Foo -> Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` If you mess up on one of the names of your command, delete short circuits -```unison +``` unison e = 11 f = 12 + e g = 13 + f h = e + f + g ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -450,7 +388,7 @@ h = e + f + g g : Nat h : Nat -.> delete.verbose e f gg +scratch/main> delete.verbose e f gg ⚠️ @@ -460,32 +398,33 @@ h = e + f + g ``` Cyclical terms which are guarded by a lambda are allowed to be deleted -```unison +``` unison ping _ = 1 Nat.+ !pong pong _ = 4 Nat.+ !ping ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: ping : 'Nat pong : 'Nat -.> delete.verbose ping +scratch/main> delete.verbose ping Removed definitions: 1. ping : 'Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -.> view pong +scratch/main> view pong pong : 'Nat pong _ = use Nat + - 4 + !#l9uq1dpl5v.1 + 4 + #l9uq1dpl5v.1() ``` diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.md b/unison-src/transcripts/dependents-dependencies-debugfile.md index 46ffce8d30..30692285ee 100644 --- a/unison-src/transcripts/dependents-dependencies-debugfile.md +++ b/unison-src/transcripts/dependents-dependencies-debugfile.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ### `debug.file` @@ -18,7 +18,7 @@ inside.q x = x + p * p inside.r = d ``` ```ucm -.> debug.file +scratch/main> debug.file ``` This will help me make progress in some situations when UCM is being deficient or broken. @@ -26,13 +26,13 @@ This will help me make progress in some situations when UCM is being deficient o ### `dependents` / `dependencies` But wait, there's more. I can check the dependencies and dependents of a definition: ```ucm -.> add -.> dependents q -.> dependencies q -.> dependencies B -.> dependencies d -.> dependents d -.> +scratch/main> add +scratch/main> dependents q +scratch/main> dependencies q +scratch/main> dependencies B +scratch/main> dependencies d +scratch/main> dependents d +scratch/main> ``` We don't have an index for dependents of constructors, but iirc if you ask for that, it will show you dependents of the structural type that provided the constructor. diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.output.md b/unison-src/transcripts/dependents-dependencies-debugfile.output.md index 413c7c2108..a02c491694 100644 --- a/unison-src/transcripts/dependents-dependencies-debugfile.output.md +++ b/unison-src/transcripts/dependents-dependencies-debugfile.output.md @@ -1,8 +1,10 @@ ### `debug.file` + I can use `debug.file` to see the hashes of the last typechecked file. Given this .u file: -```unison + +``` unison structural type outside.A = A Nat outside.B structural type outside.B = B Int outside.c = 3 @@ -14,8 +16,8 @@ inside.q x = x + p * p inside.r = d ``` -```ucm -.> debug.file +``` ucm +scratch/main> debug.file type inside.M#h37a56c5ep type outside.A#6l6krl7n4l @@ -30,9 +32,11 @@ inside.r = d This will help me make progress in some situations when UCM is being deficient or broken. ### `dependents` / `dependencies` + But wait, there's more. I can check the dependencies and dependents of a definition: -```ucm -.> add + +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -45,11 +49,11 @@ But wait, there's more. I can check the dependencies and dependents of a defini outside.c : Nat outside.d : Boolean -.> dependents q +scratch/main> dependents q q has no dependents. -.> dependencies q +scratch/main> dependencies q Dependencies of: q @@ -66,7 +70,7 @@ But wait, there's more. I can check the dependencies and dependents of a defini Tip: Try `view 4` to see the source of any numbered item in the above list. -.> dependencies B +scratch/main> dependencies B Dependencies of: type B, B @@ -78,7 +82,7 @@ But wait, there's more. I can check the dependencies and dependents of a defini Tip: Try `view 2` to see the source of any numbered item in the above list. -.> dependencies d +scratch/main> dependencies d Dependencies of: d @@ -97,7 +101,7 @@ But wait, there's more. I can check the dependencies and dependents of a defini Tip: Try `view 6` to see the source of any numbered item in the above list. -.> dependents d +scratch/main> dependents d Dependents of: d @@ -110,3 +114,4 @@ But wait, there's more. I can check the dependencies and dependents of a defini ``` We don't have an index for dependents of constructors, but iirc if you ask for that, it will show you dependents of the structural type that provided the constructor. + diff --git a/unison-src/transcripts/destructuring-binds.md b/unison-src/transcripts/destructuring-binds.md index f9a1eef975..2c8cf5a770 100644 --- a/unison-src/transcripts/destructuring-binds.md +++ b/unison-src/transcripts/destructuring-binds.md @@ -1,7 +1,7 @@ # Destructuring binds ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Here's a couple examples: @@ -19,8 +19,8 @@ ex1 tup = ``` ```ucm -.> add -.> view ex0 ex1 +scratch/main> add +scratch/main> view ex0 ex1 ``` Notice that `ex0` is printed using the `cases` syntax (but `ex1` is not). The pretty-printer currently prefers the `cases` syntax if definition can be printed using either destructuring bind or `cases`. @@ -58,8 +58,8 @@ ex5a _ = match (99 + 1, "hi") with ``` ```ucm -.> add -.> view ex5 ex5a +scratch/main> add +scratch/main> view ex5 ex5a ``` Notice how it prints both an ordinary match. @@ -74,6 +74,6 @@ ex6 x = match x with For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: ```ucm -.> add -.> view ex6 +scratch/main> add +scratch/main> view ex6 ``` diff --git a/unison-src/transcripts/destructuring-binds.output.md b/unison-src/transcripts/destructuring-binds.output.md index af097fc522..371864ee95 100644 --- a/unison-src/transcripts/destructuring-binds.output.md +++ b/unison-src/transcripts/destructuring-binds.output.md @@ -2,7 +2,7 @@ Here's a couple examples: -```unison +``` unison ex0 : Nat -> Nat ex0 n = (a, _, (c,d)) = ("uno", "dos", (n, 7)) @@ -14,7 +14,7 @@ ex1 tup = c + d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,15 +28,15 @@ ex1 tup = ex1 : (a, b, (Nat, Nat)) -> Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: ex0 : Nat -> Nat ex1 : (a, b, (Nat, Nat)) -> Nat -.> view ex0 ex1 +scratch/main> view ex0 ex1 ex0 : Nat -> Nat ex0 n = @@ -52,13 +52,13 @@ Notice that `ex0` is printed using the `cases` syntax (but `ex1` is not). The pr A destructuring bind is just syntax for a single branch pattern match. Notice that Unison detects this function as an alias of `ex1`: -```unison +``` unison ex2 : (a,b,(Nat,Nat)) -> Nat ex2 tup = match tup with (a, b, (c,d)) -> c + d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -76,13 +76,13 @@ ex2 tup = match tup with Destructuring binds can't be recursive: the left-hand side bound variables aren't available on the right hand side. For instance, this doesn't typecheck: -```unison +``` unison ex4 = (a,b) = (a Nat.+ b, 19) "Doesn't typecheck" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -104,7 +104,7 @@ ex4 = ``` Even though the parser accepts any pattern on the LHS of a bind, it looks pretty weird to see things like `12 = x`, so we avoid showing a destructuring bind when the LHS is a "literal" pattern (like `42` or "hi"). Again these examples wouldn't compile with coverage checking. -```unison +``` unison ex5 : 'Text ex5 _ = match 99 + 1 with 12 -> "Hi" @@ -116,7 +116,7 @@ ex5a _ = match (99 + 1, "hi") with _ -> "impossible" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -130,15 +130,15 @@ ex5a _ = match (99 + 1, "hi") with ex5a : 'Text ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: ex5 : 'Text ex5a : 'Text -.> view ex5 ex5a +scratch/main> view ex5 ex5a ex5 : 'Text ex5 _ = match 99 Nat.+ 1 with @@ -155,21 +155,21 @@ Notice how it prints both an ordinary match. Also, for clarity, the pretty-printer shows a single-branch match if the match shadows free variables of the scrutinee, for example: -```unison +``` unison ex6 x = match x with (x, y) -> x Nat.+ y ``` For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: ex6 : (Nat, Nat) -> Nat -.> view ex6 +scratch/main> view ex6 ex6 : (Nat, Nat) -> Nat ex6 = cases (x, y) -> x Nat.+ y diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 5e938a79a5..f2312268a8 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -1,25 +1,33 @@ ```ucm:hide -.> builtins.merge +scratch/b1> builtins.merge lib.builtins +scratch/b2> builtins.merge lib.builtins +scratch/nsx> builtins.merge lib.builtins +scratch/main> builtins.merge lib.builtins +scratch/ns1> builtins.merge lib.builtins ``` ```unison:hide x = 23 +fslkdjflskdjflksjdf = 663 ``` ```ucm -.b1> add -.b1> alias.term x fslkdjflskdjflksjdf -.> fork b1 b2 -.b2> alias.term x abc +scratch/b1> add ``` + ```unison:hide -fslkdjflskdjflksjdf = 663 +x = 23 +fslkdjflskdjflksjdf = 23 +abc = 23 +``` + +```ucm +scratch/b2> add +scratch/b1> debug.alias.term.force .x .fslkdjflskdjflksjdf ``` + ```ucm -.b0> add -.> merge.old b0 b1 -.> diff.namespace b1 b2 -.b2> diff.namespace .b1 +scratch/main> diff.namespace /b1: /b2: ``` Things we want to test: @@ -44,34 +52,35 @@ structural ability X a1 a2 where x : () ``` ```ucm -.ns1> add -.ns1> alias.term fromJust fromJust' -.ns1> alias.term helloWorld helloWorld2 -.ns1> fork .ns1 .ns2 +scratch/ns1> add +scratch/ns1> alias.term fromJust fromJust' +scratch/ns1> alias.term helloWorld helloWorld2 +scratch/ns1> branch /ns2 ``` Here's what we've done so far: ```ucm:error -.> diff.namespace nothing ns1 +scratch/main> diff.namespace .nothing /ns1: ``` ```ucm:error -.> diff.namespace ns1 ns2 +scratch/main> diff.namespace /ns1: /ns2: ``` ```unison:hide -fromJust = "asldkfjasldkfj" +junk = "asldkfjasldkfj" ``` ```ucm -.ns1b> add -.> merge.old ns1b ns1 +scratch/ns1> add +scratch/ns1> debug.alias.term.force junk fromJust +scratch/ns1> delete.term junk ``` ```unison:hide fromJust = 99 -b = "oog" +b = 999999999 d = 4 e = 5 f = 6 @@ -79,59 +88,69 @@ unique type Y a b = Y a b ``` ```ucm -.ns2> update.old -.> diff.namespace ns1 ns2 -.> alias.term ns2.d ns2.d' -.> alias.type ns2.A ns2.A' -.> alias.type ns2.X ns2.X' -.> diff.namespace ns1 ns2 -.> alias.type ns1.X ns1.X2 -.> alias.type ns2.A' ns2.A'' -.> fork ns2 ns3 -.> alias.term ns2.fromJust' ns2.yoohoo -.> delete.term.verbose ns2.fromJust' -.> diff.namespace ns3 ns2 +scratch/ns2> update +scratch/main> diff.namespace /ns1: /ns2: +scratch/ns2> alias.term d d' +scratch/ns2> alias.type A A' +scratch/ns2> alias.type X X' +scratch/main> diff.namespace /ns1: /ns2: +scratch/ns1> alias.type X X2 +scratch/ns2> alias.type A' A'' +scratch/ns2> branch /ns3 +scratch/ns2> alias.term fromJust' yoohoo +scratch/ns2> delete.term.verbose fromJust' +scratch/main> diff.namespace /ns3: /ns2: ``` ```unison:hide bdependent = "banana" ``` ```ucm -.ns3> update.old -.> diff.namespace ns2 ns3 +scratch/ns3> update +scratch/main> diff.namespace /ns2: /ns3: ``` ## Two different auto-propagated changes creating a name conflict + Currently, the auto-propagated name-conflicted definitions are not explicitly shown, only their also-conflicted dependency is shown. + ```unison:hide a = 333 b = a + 1 + +forconflicts = 777 ``` + ```ucm -.nsx> add -.> fork nsx nsy -.> fork nsx nsz +scratch/nsx> add +scratch/nsx> branch /nsy +scratch/nsx> branch /nsz ``` + ```unison:hide a = 444 ``` + ```ucm -.nsy> update.old +scratch/nsy> update ``` + ```unison:hide a = 555 ``` + ```ucm -.nsz> update.old -.> merge.old nsy nsw -``` -```ucm:error -.> merge.old nsz nsw +scratch/nsz> update +scratch/nsy> branch /nsw +scratch/nsw> debug.alias.term.force .forconflicts .a +scratch/nsw> debug.alias.term.force .forconflicts .b ``` + ```ucm -.> diff.namespace nsx nsw -.nsw> view a b +scratch/main> diff.namespace /nsx: /nsw: +scratch/nsw> view a +scratch/nsw> view b ``` ## Should be able to diff a namespace hash from history. @@ -141,7 +160,7 @@ x = 1 ``` ```ucm -.hashdiff> add +scratch/hashdiff> add ``` ```unison @@ -149,9 +168,9 @@ y = 2 ``` ```ucm -.hashdiff> add -.hashdiff> history -.hashdiff> diff.namespace 2 1 +scratch/hashdiff> add +scratch/hashdiff> history +scratch/hashdiff> diff.namespace 2 1 ``` ## diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index cacb9d1fc4..d54ff32e00 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -1,61 +1,39 @@ -```unison +``` unison x = 23 +fslkdjflskdjflksjdf = 663 ``` -```ucm - ☝️ The namespace .b1 is empty. - -.b1> add +``` ucm +scratch/b1> add ⍟ I've added these definitions: - x : ##Nat - -.b1> alias.term x fslkdjflskdjflksjdf - - Done. - -.> fork b1 b2 - - Done. - -.b2> alias.term x abc - - Done. + fslkdjflskdjflksjdf : Nat + x : Nat ``` -```unison -fslkdjflskdjflksjdf = 663 +``` unison +x = 23 +fslkdjflskdjflksjdf = 23 +abc = 23 ``` -```ucm - ☝️ The namespace .b0 is empty. - -.b0> add +``` ucm +scratch/b2> add ⍟ I've added these definitions: - fslkdjflskdjflksjdf : ##Nat - -.> merge.old b0 b1 + abc : Nat + fslkdjflskdjflksjdf : Nat + x : Nat - Here's what's changed in b1 after the merge: - - New name conflicts: - - 1. fslkdjflskdjflksjdf#u520d1t9kc : Nat - ↓ - 2. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : Nat - 3. └ fslkdjflskdjflksjdf#u520d1t9kc : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. +scratch/b1> debug.alias.term.force .x .fslkdjflskdjflksjdf - Applying changes from patch... + Done. -.> diff.namespace b1 b2 +``` +``` ucm +scratch/main> diff.namespace /b1: /b2: Resolved name conflicts: @@ -71,35 +49,19 @@ fslkdjflskdjflksjdf = 663 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) 8. fslkdjflskdjflksjdf#u520d1t9kc (removed) -.b2> diff.namespace .b1 - - Resolved name conflicts: - - 1. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : ##Nat - 2. └ fslkdjflskdjflksjdf#u520d1t9kc : ##Nat - ↓ - 3. fslkdjflskdjflksjdf#u520d1t9kc : ##Nat - - Name changes: - - Original Changes - 4. x ┐ 5. abc (added) - 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) - 8. fslkdjflskdjflksjdf#u520d1t9kc (removed) - ``` Things we want to test: -* Diffing identical namespaces -* Adds, removes, updates - * Adds with multiple names -* Moved and copied definitions - * Moves that have more that 1 initial or final name -* ... terms and types -* New patches, modified patches, deleted patches, moved patches -* With and without propagated updates + - Diffing identical namespaces + - Adds, removes, updates + - Adds with multiple names + - Moved and copied definitions + - Moves that have more that 1 initial or final name + - ... terms and types + - New patches, modified patches, deleted patches, moved patches + - With and without propagated updates -```unison +``` unison fromJust = 1 b = 2 bdependent = b @@ -110,108 +72,93 @@ structural type A a = A () structural ability X a1 a2 where x : () ``` -```ucm - ☝️ The namespace .ns1 is empty. - -.ns1> add +``` ucm +scratch/ns1> add ⍟ I've added these definitions: structural type A a structural ability X a1 a2 - b : ##Nat - bdependent : ##Nat - c : ##Nat - fromJust : ##Nat - helloWorld : ##Text + b : Nat + bdependent : Nat + c : Nat + fromJust : Nat + helloWorld : Text -.ns1> alias.term fromJust fromJust' +scratch/ns1> alias.term fromJust fromJust' Done. -.ns1> alias.term helloWorld helloWorld2 +scratch/ns1> alias.term helloWorld helloWorld2 Done. -.ns1> fork .ns1 .ns2 +scratch/ns1> branch /ns2 - Done. + Done. I've created the ns2 branch based off of ns1. + + Tip: To merge your work back into the ns1 branch, first + `switch /ns1` then `merge /ns2`. ``` Here's what we've done so far: -```ucm -.> diff.namespace nothing ns1 +``` ucm +scratch/main> diff.namespace .nothing /ns1: ⚠️ - The namespace .nothing is empty. Was there a typo? + The namespace scratch/main:.nothing is empty. Was there a typo? ``` -```ucm -.> diff.namespace ns1 ns2 +``` ucm +scratch/main> diff.namespace /ns1: /ns2: The namespaces are identical. ``` -```unison -fromJust = "asldkfjasldkfj" +``` unison +junk = "asldkfjasldkfj" ``` -```ucm - ☝️ The namespace .ns1b is empty. - -.ns1b> add +``` ucm +scratch/ns1> add ⍟ I've added these definitions: - fromJust : ##Text + junk : Text -.> merge.old ns1b ns1 +scratch/ns1> debug.alias.term.force junk fromJust - Here's what's changed in ns1 after the merge: - - New name conflicts: - - 1. fromJust#gjmq673r1v : Nat - ↓ - 2. ┌ fromJust#gjmq673r1v : Nat - 3. └ fromJust#rnbo52q2sh : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + Done. - Applying changes from patch... +scratch/ns1> delete.term junk + + Done. ``` -```unison +``` unison fromJust = 99 -b = "oog" +b = 999999999 d = 4 e = 5 f = 6 unique type Y a b = Y a b ``` -```ucm -.ns2> update.old +``` ucm +scratch/ns2> update - ⍟ I've added these definitions: - - type Y a b - d : ##Nat - e : ##Nat - f : ##Nat - - ⍟ I've updated these names to your new definition: - - b : ##Text - fromJust : ##Nat - (The old definition was also named fromJust'.) + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. -.> diff.namespace ns1 ns2 +scratch/main> diff.namespace /ns1: /ns2: Resolved name conflicts: @@ -224,11 +171,11 @@ unique type Y a b = Y a b 4. b : Nat ↓ - 5. b : Text + 5. b : Nat - 6. fromJust' : Nat + 6. bdependent : Nat ↓ - 7. fromJust' : Nat + 7. bdependent : Nat Added definitions: @@ -238,21 +185,25 @@ unique type Y a b = Y a b 11. e : Nat 12. f : Nat - 13. patch patch (added 2 updates) + Name changes: + + Original Changes + 13. fromJust' ┐ 14. fromJust#gjmq673r1v (removed) + 15. fromJust#gjmq673r1v ┘ -.> alias.term ns2.d ns2.d' +scratch/ns2> alias.term d d' Done. -.> alias.type ns2.A ns2.A' +scratch/ns2> alias.type A A' Done. -.> alias.type ns2.X ns2.X' +scratch/ns2> alias.type X X' Done. -.> diff.namespace ns1 ns2 +scratch/main> diff.namespace /ns1: /ns2: Resolved name conflicts: @@ -265,11 +216,11 @@ unique type Y a b = Y a b 4. b : Nat ↓ - 5. b : Text + 5. b : Nat - 6. fromJust' : Nat + 6. bdependent : Nat ↓ - 7. fromJust' : Nat + 7. bdependent : Nat Added definitions: @@ -280,65 +231,68 @@ unique type Y a b = Y a b 12. e : Nat 13. f : Nat - 14. patch patch (added 2 updates) - Name changes: - Original Changes - 15. A 16. A' (added) + Original Changes + 14. A 15. A' (added) + + 16. X 17. X' (added) - 17. X 18. X' (added) + 18. fromJust' ┐ 19. fromJust#gjmq673r1v (removed) + 20. fromJust#gjmq673r1v ┘ -.> alias.type ns1.X ns1.X2 +scratch/ns1> alias.type X X2 Done. -.> alias.type ns2.A' ns2.A'' +scratch/ns2> alias.type A' A'' Done. -.> fork ns2 ns3 +scratch/ns2> branch /ns3 - Done. + Done. I've created the ns3 branch based off of ns2. + + Tip: To merge your work back into the ns2 branch, first + `switch /ns2` then `merge /ns3`. -.> alias.term ns2.fromJust' ns2.yoohoo +scratch/ns2> alias.term fromJust' yoohoo Done. -.> delete.term.verbose ns2.fromJust' +scratch/ns2> delete.term.verbose fromJust' Name changes: - Original Changes - 1. ns2.fromJust ┐ 2. ns2.fromJust' (removed) - 3. ns2.fromJust' │ - 4. ns2.yoohoo │ - 5. ns3.fromJust │ - 6. ns3.fromJust' ┘ + Original Changes + 1. fromJust' ┐ 2. fromJust' (removed) + 3. yoohoo ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. -.> diff.namespace ns3 ns2 +scratch/main> diff.namespace /ns3: /ns2: Name changes: Original Changes - 1. fromJust ┐ 2. yoohoo (added) - 3. fromJust' ┘ 4. fromJust' (removed) + 1. fromJust' 2. yoohoo (added) + 3. fromJust' (removed) ``` -```unison +``` unison bdependent = "banana" ``` -```ucm -.ns3> update.old +``` ucm +scratch/ns3> update - ⍟ I've updated these names to your new definition: - - bdependent : ##Text + Okay, I'm searching the branch for code that needs to be + updated... + + Done. -.> diff.namespace ns2 ns3 +scratch/main> diff.namespace /ns2: /ns3: Updates: @@ -346,157 +300,145 @@ bdependent = "banana" ↓ 2. bdependent : Text - 3. patch patch (added 1 updates) - Name changes: - Original Changes - 4. fromJust ┐ 5. fromJust' (added) - 6. yoohoo ┘ 7. yoohoo (removed) + Original Changes + 3. yoohoo 4. fromJust' (added) + 5. yoohoo (removed) ``` ## Two different auto-propagated changes creating a name conflict + Currently, the auto-propagated name-conflicted definitions are not explicitly shown, only their also-conflicted dependency is shown. -```unison + +``` unison a = 333 b = a + 1 -``` -```ucm - ☝️ The namespace .nsx is empty. +forconflicts = 777 +``` -.nsx> add +``` ucm +scratch/nsx> add ⍟ I've added these definitions: - a : ##Nat - b : ##Nat + a : Nat + b : Nat + forconflicts : Nat -.> fork nsx nsy +scratch/nsx> branch /nsy - Done. + Done. I've created the nsy branch based off of nsx. + + Tip: To merge your work back into the nsx branch, first + `switch /nsx` then `merge /nsy`. -.> fork nsx nsz +scratch/nsx> branch /nsz - Done. + Done. I've created the nsz branch based off of nsx. + + Tip: To merge your work back into the nsx branch, first + `switch /nsx` then `merge /nsz`. ``` -```unison +``` unison a = 444 ``` -```ucm -.nsy> update.old +``` ucm +scratch/nsy> update - ⍟ I've updated these names to your new definition: - - a : ##Nat + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. ``` -```unison +``` unison a = 555 ``` -```ucm -.nsz> update.old +``` ucm +scratch/nsz> update - ⍟ I've updated these names to your new definition: - - a : ##Nat + Okay, I'm searching the branch for code that needs to be + updated... -.> merge.old nsy nsw + That's done. Now I'm making sure everything typechecks... - Here's what's changed in nsw after the merge: - - Added definitions: - - 1. a : Nat - 2. b : Nat - - 3. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + Everything typechecks, so I'm saving the results... - Applying changes from patch... + Done. -``` -```ucm -.> merge.old nsz nsw +scratch/nsy> branch /nsw - Here's what's changed in nsw after the merge: - - New name conflicts: + Done. I've created the nsw branch based off of nsy. - 1. a#mdl4vqtu00 : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#vrs8gtkl2t : Nat - - 4. b#unkqhuu66p : Nat - ↓ - 5. ┌ b#aapqletas7 : Nat - 6. └ b#unkqhuu66p : Nat - - Updates: - - 7. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + Tip: To merge your work back into the nsy branch, first + `switch /nsy` then `merge /nsw`. - Applying changes from patch... +scratch/nsw> debug.alias.term.force .forconflicts .a + + Done. - I tried to auto-apply the patch, but couldn't because it - contained contradictory entries. +scratch/nsw> debug.alias.term.force .forconflicts .b + + Done. ``` -```ucm -.> diff.namespace nsx nsw +``` ucm +scratch/main> diff.namespace /nsx: /nsw: New name conflicts: 1. a#uiiiv8a86s : Nat ↓ 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#vrs8gtkl2t : Nat + 3. └ a#r3msrbpp1v : Nat 4. b#lhigeb1let : Nat ↓ - 5. ┌ b#aapqletas7 : Nat + 5. ┌ b#r3msrbpp1v : Nat 6. └ b#unkqhuu66p : Nat - Added definitions: + Name changes: - 7. patch patch (added 2 updates) + Original Changes + 7. forconflicts 8. a#r3msrbpp1v (added) + 9. b#r3msrbpp1v (added) -.nsw> view a b +scratch/nsw> view a - a#mdl4vqtu00 : ##Nat + a#mdl4vqtu00 : Nat a#mdl4vqtu00 = 444 - a#vrs8gtkl2t : ##Nat - a#vrs8gtkl2t = 555 - - b#aapqletas7 : ##Nat - b#aapqletas7 = ##Nat.+ a#vrs8gtkl2t 1 + a#r3msrbpp1v : Nat + a#r3msrbpp1v = 777 + +scratch/nsw> view b + + b#r3msrbpp1v : Nat + b#r3msrbpp1v = 777 - b#unkqhuu66p : ##Nat - b#unkqhuu66p = ##Nat.+ a#mdl4vqtu00 1 + b#unkqhuu66p : Nat + b#unkqhuu66p = + use Nat + + a#mdl4vqtu00 + 1 ``` ## Should be able to diff a namespace hash from history. -```unison +``` unison x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -506,24 +448,22 @@ x = 1 ⍟ These new definitions are ok to `add`: - x : ##Nat + x : Nat ``` -```ucm - ☝️ The namespace .hashdiff is empty. - -.hashdiff> add +``` ucm +scratch/hashdiff> add ⍟ I've added these definitions: x : ##Nat ``` -```unison +``` unison y = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -536,14 +476,14 @@ y = 2 y : ##Nat ``` -```ucm -.hashdiff> add +``` ucm +scratch/hashdiff> add ⍟ I've added these definitions: y : ##Nat -.hashdiff> history +scratch/hashdiff> history Note: The most recent namespace hash is immediately below this message. @@ -556,56 +496,57 @@ y = 2 □ 2. #i52j9fd57b (start of history) -.hashdiff> diff.namespace 2 1 +scratch/hashdiff> diff.namespace 2 1 Added definitions: 1. y : ##Nat ``` -## +## Updates: -- 1 to 1 New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) - 1. foo#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so - ↓ - 2. ┌ foo#0ja1qfpej6 : Nat - 3. └ foo#jk19sm5bf8 : Nat +1. foo\#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so + ↓ +2. ┌ foo\#0ja1qfpej6 : Nat +3. └ foo\#jk19sm5bf8 : Nat Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one - 4. ┌ bar#0ja1qfpej6 : Nat - 5. └ bar#jk19sm5bf8 : Nat - ↓ - 6. bar#jk19sm5bf8 : Nat +4. ┌ bar\#0ja1qfpej6 : Nat +5. └ bar\#jk19sm5bf8 : Nat + ↓ +6. bar\#jk19sm5bf8 : Nat ## Display issues to fixup -- [d] Do we want to surface new edit conflicts in patches? -- [t] two different auto-propagated changes creating a name conflict should show - up somewhere besides the auto-propagate count -- [t] Things look screwy when the type signature doesn't fit and has to get broken - up into multiple lines. Maybe just disallow that? -- [d] Delete blank line in between copies / renames entries if all entries are 1 to 1 - see todo in the code -- [x] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) -- [x] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) -- [x] might want unqualified names to be qualified sometimes: -- [x] if a name is updated to a not-yet-named reference, it's shown as both an update and an add -- [x] similarly, if a conflicted name is resolved by deleting the last name to - a reference, I (arya) suspect it will show up as a Remove -- [d] Maybe group and/or add headings to the types, constructors, terms -- [x] add tagging of propagated updates to test propagated updates output -- [x] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) -- [x] delete.term has some bonkers output -- [x] Make a decision about how we want to show constructors in the diff -- [x] 12.patch patch needs a space -- [x] This looks like garbage -- [x] Extra 2 blank lines at the end of the add section -- [x] Fix alignment issues with buildTable, convert to column3M (to be written) -- [x] adding an alias is showing up as an Add and a Copy; should just show as Copy -- [x] removing one of multiple aliases appears in removes + moves + copies section -- [x] some overlapping cases between Moves and Copies^ -- [x] Maybe don't list the type signature twice for aliases? + - \[d\] Do we want to surface new edit conflicts in patches? + - \[t\] two different auto-propagated changes creating a name conflict should show + up somewhere besides the auto-propagate count + - \[t\] Things look screwy when the type signature doesn't fit and has to get broken + up into multiple lines. Maybe just disallow that? + - \[d\] Delete blank line in between copies / renames entries if all entries are 1 to 1 + see todo in the code + - \[x\] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) + - \[x\] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) + - \[x\] might want unqualified names to be qualified sometimes: + - \[x\] if a name is updated to a not-yet-named reference, it's shown as both an update and an add + - \[x\] similarly, if a conflicted name is resolved by deleting the last name to + a reference, I (arya) suspect it will show up as a Remove + - \[d\] Maybe group and/or add headings to the types, constructors, terms + - \[x\] add tagging of propagated updates to test propagated updates output + - \[x\] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) + - \[x\] delete.term has some bonkers output + - \[x\] Make a decision about how we want to show constructors in the diff + - \[x\] 12.patch patch needs a space + - \[x\] This looks like garbage + - \[x\] Extra 2 blank lines at the end of the add section + - \[x\] Fix alignment issues with buildTable, convert to column3M (to be written) + - \[x\] adding an alias is showing up as an Add and a Copy; should just show as Copy + - \[x\] removing one of multiple aliases appears in removes + moves + copies section + - \[x\] some overlapping cases between Moves and Copies^ + - \[x\] Maybe don't list the type signature twice for aliases? + diff --git a/unison-src/transcripts/doc-formatting.md b/unison-src/transcripts/doc-formatting.md index 51f6c51bca..a6076ccc6c 100644 --- a/unison-src/transcripts/doc-formatting.md +++ b/unison-src/transcripts/doc-formatting.md @@ -3,53 +3,53 @@ This transcript explains a few minor details about doc parsing and pretty-printi Docs can be used as inline code comments. ```ucm:hide -.> builtins.merge +scratch/main> builtins.mergeio ``` ```unison foo : Nat -> Nat foo n = - _ = [: do the thing :] + _ = {{ do the thing }} n + 1 ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view foo +scratch/main> view foo ``` -Note that `@` and `:]` must be escaped within docs. +Note that `{{`, `@`, and `}}` must be escaped within docs. ```unison -escaping = [: Docs look [: like \@this \:] :] +escaping = {{ Docs look --doc open-- like --amphora--this --doc close-- }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view escaping +scratch/main> view escaping ``` -(Alas you can't have `\@` or `\:]` in your doc, as there's currently no way to 'unescape' them.) +(Alas you can't have `\@` or `\}}` in your doc, as there's currently no way to 'unescape' them.) ```unison -- Note that -- comments are preserved within doc literals. -commented = [: +commented = {{ example: -- a comment f x = x + 1 -:] +}} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view commented +scratch/main> view commented ``` ### Indenting, and paragraph reflow @@ -60,37 +60,37 @@ Handling of indenting in docs between the parser and pretty-printer is a bit fid -- The leading and trailing spaces are stripped from the stored Doc by the -- lexer, and one leading and trailing space is inserted again on view/edit -- by the pretty-printer. -doc1 = [: hi :] +doc1 = {{ hi }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc1 +scratch/main> view doc1 ``` ```unison --- Lines (apart from the first line, i.e. the bit between the [: and the +-- Lines (apart from the first line, i.e. the bit between the {{ and the -- first newline) are unindented until at least one of -- them hits the left margin (by a post-processing step in the parser). -- You may not notice this because the pretty-printer indents them again on -- view/edit. -doc2 = [: hello +doc2 = {{ hello - foo - bar - and the rest. :] + and the rest. }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc2 +scratch/main> view doc2 ``` ```unison -doc3 = [: When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. +doc3 = {{ When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. For these purposes, a paragraph is any sequence of non-empty lines that have zero indent (after the unindenting mentioned above.) @@ -101,81 +101,81 @@ For these purposes, a paragraph is any sequence of non-empty lines that have zer is not treated | either. Note that because of the special treatment of the first line mentioned above, where its leading space is removed, it is always treated as a paragraph. - :] + }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc3 +scratch/main> view doc3 ``` ```unison -doc4 = [: Here's another example of some paragraphs. +doc4 = {{ Here's another example of some paragraphs. All these lines have zero indent. - - Apart from this one. :] + - Apart from this one. }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc4 +scratch/main> view doc4 ``` ```unison -- The special treatment of the first line does mean that the following -- is pretty-printed not so prettily. To fix that we'd need to get the -- lexer to help out with interpreting doc literal indentation (because --- it knows what columns the `[:` was in.) -doc5 = [: - foo +-- it knows what columns the `{{` was in.) +doc5 = {{ - foo - bar - and the rest. :] + and the rest. }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc5 +scratch/main> view doc5 ``` ```unison -- You can do the following to avoid that problem. -doc6 = [: +doc6 = {{ - foo - bar and the rest. - :] + }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc6 +scratch/main> view doc6 ``` ### More testing ```unison -- Check empty doc works. -empty = [::] +empty = {{}} expr = foo 1 ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view empty +scratch/main> view empty ``` ```unison -test1 = [: +test1 = {{ The internal logic starts to get hairy when you use the \@ features, for example referencing a name like @List.take. Internally, the text between each such usage is its own blob (blob ends here --> @List.take), so paragraph reflow has to be aware of multiple blobs to do paragraph reflow (or, more accurately, to do the normalization step where newlines with a paragraph are removed.) Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor ending in ref @List.take @@ -211,44 +211,44 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo -- note the leading space below @[signature] List.take -:] +}} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view test1 +scratch/main> view test1 ``` ```unison -- Regression test for #1363 - preservation of spaces after @ directives in first line when unindenting -reg1363 = [: `@List.take foo` bar - baz :] +reg1363 = {{ `@List.take foo` bar + baz }} ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view reg1363 +scratch/main> view reg1363 ``` ```unison -- Demonstrate doc display when whitespace follows a @[source] or @[evaluate] -- whose output spans multiple lines. -test2 = [: +test2 = {{ Take a look at this: @[source] foo ▶ bar -:] +}} ``` ```ucm:hide -.> add +scratch/main> add ``` View is fine. ```ucm -.> view test2 +scratch/main> view test2 ``` But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: ```ucm -.> display test2 +scratch/main> display test2 ``` diff --git a/unison-src/transcripts/doc-formatting.output.md b/unison-src/transcripts/doc-formatting.output.md index d4c000906f..64e6c779f3 100644 --- a/unison-src/transcripts/doc-formatting.output.md +++ b/unison-src/transcripts/doc-formatting.output.md @@ -2,14 +2,14 @@ This transcript explains a few minor details about doc parsing and pretty-printi Docs can be used as inline code comments. -```unison +``` unison foo : Nat -> Nat foo n = - _ = [: do the thing :] + _ = {{ do the thing }} n + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,23 +22,23 @@ foo n = foo : Nat -> Nat ``` -```ucm -.> view foo +``` ucm +scratch/main> view foo foo : Nat -> Nat foo n = use Nat + - _ = [: do the thing :] + _ = {{ do the thing }} n + 1 ``` -Note that `@` and `:]` must be escaped within docs. +Note that `{{`, `@`, and `}}` must be escaped within docs. -```unison -escaping = [: Docs look [: like \@this \:] :] +``` unison +escaping = {{ Docs look --doc open-- like --amphora--this --doc close-- }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -48,29 +48,32 @@ escaping = [: Docs look [: like \@this \:] :] ⍟ These new definitions are ok to `add`: - escaping : Doc + escaping : Doc2 ``` -```ucm -.> view escaping +``` ucm +scratch/main> view escaping - escaping : Doc - escaping = [: Docs look [: like \@this \:] :] + escaping : Doc2 + escaping = + {{ + Docs look --doc open-- like --amphora--this --doc close-- + }} ``` -(Alas you can't have `\@` or `\:]` in your doc, as there's currently no way to 'unescape' them.) +(Alas you can't have `\@` or `\}}` in your doc, as there's currently no way to 'unescape' them.) -```unison +``` unison -- Note that -- comments are preserved within doc literals. -commented = [: +commented = {{ example: -- a comment f x = x + 1 -:] +}} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -80,32 +83,33 @@ commented = [: ⍟ These new definitions are ok to `add`: - commented : Doc + commented : Doc2 ``` -```ucm -.> view commented +``` ucm +scratch/main> view commented - commented : Doc + commented : Doc2 commented = - [: example: + {{ + example: -- a comment f x = x + 1 - :] + }} ``` ### Indenting, and paragraph reflow Handling of indenting in docs between the parser and pretty-printer is a bit fiddly. -```unison +``` unison -- The leading and trailing spaces are stripped from the stored Doc by the -- lexer, and one leading and trailing space is inserted again on view/edit -- by the pretty-printer. -doc1 = [: hi :] +doc1 = {{ hi }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -115,29 +119,29 @@ doc1 = [: hi :] ⍟ These new definitions are ok to `add`: - doc1 : Doc + doc1 : Doc2 ``` -```ucm -.> view doc1 +``` ucm +scratch/main> view doc1 - doc1 : Doc - doc1 = [: hi :] + doc1 : Doc2 + doc1 = {{ hi }} ``` -```unison --- Lines (apart from the first line, i.e. the bit between the [: and the +``` unison +-- Lines (apart from the first line, i.e. the bit between the {{ and the -- first newline) are unindented until at least one of -- them hits the left margin (by a post-processing step in the parser). -- You may not notice this because the pretty-printer indents them again on -- view/edit. -doc2 = [: hello +doc2 = {{ hello - foo - bar - and the rest. :] + and the rest. }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -147,22 +151,18 @@ doc2 = [: hello ⍟ These new definitions are ok to `add`: - doc2 : Doc + doc2 : Doc2 ``` -```ucm -.> view doc2 +``` ucm +scratch/main> view doc2 - doc2 : Doc - doc2 = - [: hello - - foo - - bar - and the rest. :] + doc2 : Doc2 + doc2 = {{ hello - foo - bar and the rest. }} ``` -```unison -doc3 = [: When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. +``` unison +doc3 = {{ When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. For these purposes, a paragraph is any sequence of non-empty lines that have zero indent (after the unindenting mentioned above.) @@ -173,10 +173,10 @@ For these purposes, a paragraph is any sequence of non-empty lines that have zer is not treated | either. Note that because of the special treatment of the first line mentioned above, where its leading space is removed, it is always treated as a paragraph. - :] + }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -186,44 +186,43 @@ Note that because of the special treatment of the first line mentioned above, wh ⍟ These new definitions are ok to `add`: - doc3 : Doc + doc3 : Doc2 ``` -```ucm -.> view doc3 +``` ucm +scratch/main> view doc3 - doc3 : Doc + doc3 : Doc2 doc3 = - [: When Unison identifies a paragraph, it removes any - newlines from it before storing it, and then reflows the - paragraph text to fit the display window on - display/view/edit. + {{ + When Unison identifies a paragraph, it removes any newlines + from it before storing it, and then reflows the paragraph + text to fit the display window on display/view/edit. For these purposes, a paragraph is any sequence of non-empty lines that have zero indent (after the unindenting mentioned above.) - - So this is not a paragraph, even - though you might want it to be. + * So this is not a paragraph, even though you might want it + to be. - And this text | as a paragraph - is not treated | either. + And this text | as a paragraph is not treated | either. Note that because of the special treatment of the first line - mentioned above, where its leading space is removed, it is + mentioned above, where its leading space is removed, it is always treated as a paragraph. - :] + }} ``` -```unison -doc4 = [: Here's another example of some paragraphs. +``` unison +doc4 = {{ Here's another example of some paragraphs. All these lines have zero indent. - - Apart from this one. :] + - Apart from this one. }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -233,32 +232,34 @@ doc4 = [: Here's another example of some paragraphs. ⍟ These new definitions are ok to `add`: - doc4 : Doc + doc4 : Doc2 ``` -```ucm -.> view doc4 +``` ucm +scratch/main> view doc4 - doc4 : Doc + doc4 : Doc2 doc4 = - [: Here's another example of some paragraphs. + {{ + Here's another example of some paragraphs. All these lines have zero indent. - - Apart from this one. :] + * Apart from this one. + }} ``` -```unison +``` unison -- The special treatment of the first line does mean that the following -- is pretty-printed not so prettily. To fix that we'd need to get the -- lexer to help out with interpreting doc literal indentation (because --- it knows what columns the `[:` was in.) -doc5 = [: - foo +-- it knows what columns the `{{` was in.) +doc5 = {{ - foo - bar - and the rest. :] + and the rest. }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -268,29 +269,32 @@ doc5 = [: - foo ⍟ These new definitions are ok to `add`: - doc5 : Doc + doc5 : Doc2 ``` -```ucm -.> view doc5 +``` ucm +scratch/main> view doc5 - doc5 : Doc + doc5 : Doc2 doc5 = - [: - foo - - bar - and the rest. :] + {{ + * foo + * bar + + and the rest. + }} ``` -```unison +``` unison -- You can do the following to avoid that problem. -doc6 = [: +doc6 = {{ - foo - bar and the rest. - :] + }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -300,30 +304,33 @@ doc6 = [: ⍟ These new definitions are ok to `add`: - doc6 : Doc + doc6 : Doc2 + (also named doc5) ``` -```ucm -.> view doc6 +``` ucm +scratch/main> view doc6 - doc6 : Doc + doc6 : Doc2 doc6 = - [: - foo - - bar + {{ + * foo + * bar + and the rest. - :] + }} ``` ### More testing -```unison +``` unison -- Check empty doc works. -empty = [::] +empty = {{}} expr = foo 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -333,19 +340,19 @@ expr = foo 1 ⍟ These new definitions are ok to `add`: - empty : Doc + empty : Doc2 expr : Nat ``` -```ucm -.> view empty +``` ucm +scratch/main> view empty - empty : Doc - empty = [: :] + empty : Doc2 + empty = {{ }} ``` -```unison -test1 = [: +``` unison +test1 = {{ The internal logic starts to get hairy when you use the \@ features, for example referencing a name like @List.take. Internally, the text between each such usage is its own blob (blob ends here --> @List.take), so paragraph reflow has to be aware of multiple blobs to do paragraph reflow (or, more accurately, to do the normalization step where newlines with a paragraph are removed.) Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor ending in ref @List.take @@ -381,10 +388,10 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo -- note the leading space below @[signature] List.take -:] +}} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -394,57 +401,60 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo ⍟ These new definitions are ok to `add`: - test1 : Doc + test1 : Doc2 ``` -```ucm -.> view test1 +``` ucm +scratch/main> view test1 - test1 : Doc + test1 : Doc2 test1 = - [: The internal logic starts to get hairy when you use the - \@ features, for example referencing a name like @List.take. + {{ + The internal logic starts to get hairy when you use the \@ + features, for example referencing a name like @List.take. Internally, the text between each such usage is its own blob - (blob ends here --> @List.take), so paragraph reflow has to - be aware of multiple blobs to do paragraph reflow (or, more + (blob ends here --> @List.take), so paragraph reflow has to + be aware of multiple blobs to do paragraph reflow (or, more accurately, to do the normalization step where newlines with a paragraph are removed.) - Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem - ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum + Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem + ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor ending in ref @List.take @List.take starting para lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem + lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - Middle of para: lorem ipsum dolor lorem ipsum dolor lorem - ipsum dolor @List.take lorem ipsum dolor lorem ipsum dolor + Middle of para: lorem ipsum dolor lorem ipsum dolor lorem + ipsum dolor @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - - non-para line (@List.take) with ref @List.take - Another non-para line - @List.take starting non-para line + * non-para line (@List.take) with ref @List.take + + Another non-para line @List.take starting non-para line + + * non-para line with ref @List.take - - non-para line with ref @List.take before a para-line lorem ipsum dolor lorem ipsum dolor lorem - ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum + ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - - non-para line followed by a para line starting with ref - @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + * non-para line followed by a para line starting with ref + + @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - a para-line ending with ref lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take - - non-para line + a para-line ending with ref lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + @List.take - non-para line - para line lorem ipsum dolor lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor - @List.take followed by non-para line starting with ref. + para line lorem ipsum dolor lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + lorem ipsum dolor lorem ipsum dolor @List.take followed by + non-para line starting with ref. @[signature] List.take @@ -454,19 +464,17 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo @[include] doc1 - -- note the leading space below - @[signature] List.take - - :] + -- note the leading space below @[signature] List.take + }} ``` -```unison +``` unison -- Regression test for #1363 - preservation of spaces after @ directives in first line when unindenting -reg1363 = [: `@List.take foo` bar - baz :] +reg1363 = {{ `@List.take foo` bar + baz }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -476,27 +484,27 @@ reg1363 = [: `@List.take foo` bar ⍟ These new definitions are ok to `add`: - reg1363 : Doc + reg1363 : Doc2 ``` -```ucm -.> view reg1363 +``` ucm +scratch/main> view reg1363 - reg1363 : Doc - reg1363 = [: `@List.take foo` bar baz :] + reg1363 : Doc2 + reg1363 = {{ `@List.take foo` bar baz }} ``` -```unison +``` unison -- Demonstrate doc display when whitespace follows a @[source] or @[evaluate] -- whose output spans multiple lines. -test2 = [: +test2 = {{ Take a look at this: @[source] foo ▶ bar -:] +}} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -506,30 +514,23 @@ test2 = [: ⍟ These new definitions are ok to `add`: - test2 : Doc + test2 : Doc2 ``` View is fine. -```ucm -.> view test2 - test2 : Doc - test2 = - [: Take a look at this: - @[source] foo ▶ bar - :] +``` ucm +scratch/main> view test2 + + test2 : Doc2 + test2 = {{ Take a look at this: @[source] foo ▶ bar }} ``` But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: -```ucm -.> display test2 - Take a look at this: - foo : Nat -> Nat - foo n = - use Nat + - _ = [: do the thing :] - n + 1 ▶ bar - +``` ucm +scratch/main> display test2 + + Take a look at this: @[source] foo ▶ bar ``` diff --git a/unison-src/transcripts/doc-type-link-keywords.md b/unison-src/transcripts/doc-type-link-keywords.md index a4cb0007aa..736e256dea 100644 --- a/unison-src/transcripts/doc-type-link-keywords.md +++ b/unison-src/transcripts/doc-type-link-keywords.md @@ -7,7 +7,7 @@ not the ability `Patterns`; the lexer should see this as a single identifier. See https://github.com/unisonweb/unison/issues/2642 for an example. ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -28,14 +28,14 @@ docs.example4 = {{A doc that links to the {type Labels} type}} ``` ```ucm:hide -.> add +scratch/main> add ``` Now we check that each doc links to the object of the correct name: ```ucm -.> display docs.example1 -.> display docs.example2 -.> display docs.example3 -.> display docs.example4 +scratch/main> display docs.example1 +scratch/main> display docs.example2 +scratch/main> display docs.example3 +scratch/main> display docs.example4 ``` diff --git a/unison-src/transcripts/doc-type-link-keywords.output.md b/unison-src/transcripts/doc-type-link-keywords.output.md index 9eea235a15..e1b04a715c 100644 --- a/unison-src/transcripts/doc-type-link-keywords.output.md +++ b/unison-src/transcripts/doc-type-link-keywords.output.md @@ -6,7 +6,7 @@ not the ability `Patterns`; the lexer should see this as a single identifier. See https://github.com/unisonweb/unison/issues/2642 for an example. -```unison +``` unison abilityPatterns : () abilityPatterns = () @@ -25,20 +25,20 @@ docs.example4 = {{A doc that links to the {type Labels} type}} Now we check that each doc links to the object of the correct name: -```ucm -.> display docs.example1 +``` ucm +scratch/main> display docs.example1 A doc that links to the abilityPatterns term -.> display docs.example2 +scratch/main> display docs.example2 A doc that links to the Patterns ability -.> display docs.example3 +scratch/main> display docs.example3 A doc that links to the typeLabels term -.> display docs.example4 +scratch/main> display docs.example4 A doc that links to the Labels type diff --git a/unison-src/transcripts/doc1.md b/unison-src/transcripts/doc1.md index 7379c47198..88e483459d 100644 --- a/unison-src/transcripts/doc1.md +++ b/unison-src/transcripts/doc1.md @@ -1,83 +1,71 @@ # Documenting Unison code ```ucm:hide -.> builtins.merge +scratch/main> builtins.mergeio lib.builtins ``` Unison documentation is written in Unison. Documentation is a value of the following type: ```ucm -.builtin> view Doc +scratch/main> view lib.builtins.Doc ``` You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: ```unison -doc1 = [: This is some documentation. +doc = {{ This is some documentation. It can span multiple lines. -Can link to definitions like @List.drop or @List +Can link to definitions like {List.drop} or {type List} -:] +}} ``` Syntax: -`[:` starts a documentation block; `:]` finishes it. Within the block: +`{{` starts a documentation block; `}}` finishes it. Within the block: -* Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. -* `@[signature] List.take` expands to the type signature of `List.take` -* `@[source] List.map` expands to the full source of `List.map` -* `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. -* `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). +* Links to definitions are done with `{type List}`. +* `@signature{List.take}` expands to the type signature of `List.take` +* `@source{List.map}` expands to the full source of `List.map` +* `{{ someOtherDoc }}`, inserts a value `someOtherDoc : Doc` here. +* `@eval{someDefinition}` expands to the result of evaluating `someDefinition`, which can be an arbitrary expression. ### An example -We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: +We are going to document `List.take` using some verbiage and a few examples. -```unison -List.take.ex1 = take 0 [1,2,3,4,5] -List.take.ex2 = take 2 [1,2,3,4,5] -``` - -```ucm -.builtin> add -``` - -And now let's write our docs and reference these examples: - -```unison -List.take.doc = [: -`@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) +````unison +List.take.doc = {{ +`List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) ## Examples: - @[source] List.take.ex1 - 🔽 - @List.take.ex1 = @[evaluate] List.take.ex1 - +``` +take 0 [1,2,3,4,5] +``` - @[source] List.take.ex2 - 🔽 - @List.take.ex2 = @[evaluate] List.take.ex2 -:] ``` +take 2 [1,2,3,4,5] +``` +}} +```` Let's add it to the codebase. ```ucm -.builtin> add +scratch/main> add ``` We can view it with `docs`, which shows the `Doc` value that is associated with a definition. ```ucm -.builtin> docs List.take +scratch/main> docs List.take ``` Note that if we view the source of the documentation, the various references are *not* expanded. ```ucm -.builtin> view List.take +scratch/main> view List.take ``` diff --git a/unison-src/transcripts/doc1.output.md b/unison-src/transcripts/doc1.output.md index 9fc30e1602..90c495d57a 100644 --- a/unison-src/transcripts/doc1.output.md +++ b/unison-src/transcripts/doc1.output.md @@ -2,31 +2,31 @@ Unison documentation is written in Unison. Documentation is a value of the following type: -```ucm -.builtin> view Doc +``` ucm +scratch/main> view lib.builtins.Doc - type Doc + type lib.builtins.Doc = Blob Text | Link Link | Source Link - | Signature Term - | Evaluate Term - | Join [Doc] + | Signature Link.Term + | Evaluate Link.Term + | Join [lib.builtins.Doc] ``` You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: -```unison -doc1 = [: This is some documentation. +``` unison +doc = {{ This is some documentation. It can span multiple lines. -Can link to definitions like @List.drop or @List +Can link to definitions like {List.drop} or {type List} -:] +}} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,71 +36,40 @@ Can link to definitions like @List.drop or @List ⍟ These new definitions are ok to `add`: - doc1 : Doc + doc : Doc2 ``` Syntax: -`[:` starts a documentation block; `:]` finishes it. Within the block: +`{{` starts a documentation block; `}}` finishes it. Within the block: -* Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. -* `@[signature] List.take` expands to the type signature of `List.take` -* `@[source] List.map` expands to the full source of `List.map` -* `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. -* `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). + - Links to definitions are done with `{type List}`. + - `@signature{List.take}` expands to the type signature of `List.take` + - `@source{List.map}` expands to the full source of `List.map` + - `{{ someOtherDoc }}`, inserts a value `someOtherDoc : Doc` here. + - `@eval{someDefinition}` expands to the result of evaluating `someDefinition`, which can be an arbitrary expression. ### An example -We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: +We are going to document `List.take` using some verbiage and a few examples. -```unison -List.take.ex1 = take 0 [1,2,3,4,5] -List.take.ex2 = take 2 [1,2,3,4,5] -``` - -```ucm - - Loading changes detected in scratch.u. +```` unison +List.take.doc = {{ +`List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - List.take.ex1 : [Nat] - List.take.ex2 : [Nat] +## Examples: ``` -```ucm -.builtin> add - - ⍟ I've added these definitions: - - List.take.ex1 : [Nat] - List.take.ex2 : [Nat] - +take 0 [1,2,3,4,5] ``` -And now let's write our docs and reference these examples: - -```unison -List.take.doc = [: -`@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) - -## Examples: - @[source] List.take.ex1 - 🔽 - @List.take.ex1 = @[evaluate] List.take.ex1 - - - @[source] List.take.ex2 - 🔽 - @List.take.ex2 = @[evaluate] List.take.ex2 -:] ``` +take 2 [1,2,3,4,5] +``` +}} +```` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -110,49 +79,46 @@ List.take.doc = [: ⍟ These new definitions are ok to `add`: - List.take.doc : Doc + List.take.doc : Doc2 ``` Let's add it to the codebase. -```ucm -.builtin> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - List.take.doc : Doc + List.take.doc : Doc2 ``` We can view it with `docs`, which shows the `Doc` value that is associated with a definition. -```ucm -.builtin> docs List.take +``` ucm +scratch/main> docs List.take - `List.take n xs` returns the first `n` elements of `xs`. (No - need to add line breaks manually. The display command will do - wrapping of text for you. Indent any lines where you don't + `List.take n xs` returns the first `n` elements of `xs`. (No + need to add line breaks manually. The display command will do + wrapping of text for you. Indent any lines where you don't want it to do this.) - ## Examples: - - List.take.ex1 : [Nat] - List.take.ex1 = List.take 0 [1, 2, 3, 4, 5] - 🔽 - ex1 = [] - + # Examples: - List.take.ex2 : [Nat] - List.take.ex2 = List.take 2 [1, 2, 3, 4, 5] - 🔽 - ex2 = [1, 2] + List.take 0 [1, 2, 3, 4, 5] + ⧨ + [] + List.take 2 [1, 2, 3, 4, 5] + ⧨ + [1, 2] ``` Note that if we view the source of the documentation, the various references are *not* expanded. -```ucm -.builtin> view List.take +``` ucm +scratch/main> view List.take - builtin List.take : Nat -> [a] -> [a] + builtin lib.builtins.List.take : + lib.builtins.Nat -> [a] -> [a] ``` diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md index 278cc8f493..32cb274290 100644 --- a/unison-src/transcripts/doc2.md +++ b/unison-src/transcripts/doc2.md @@ -1,7 +1,7 @@ # Test parsing and round-trip of doc2 syntax elements ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -114,5 +114,5 @@ Inline '' text literal with 1 space of padding '' in the middle of a sentence. Format it to check that everything pretty-prints in a valid way. ```ucm -.> debug.format +scratch/main> debug.format ``` diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index e303b639a4..dc8330c537 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -1,6 +1,6 @@ # Test parsing and round-trip of doc2 syntax elements -```unison +``` unison otherDoc : a -> Doc2 otherDoc _ = {{ yo }} @@ -109,11 +109,11 @@ Inline '' text literal with 1 space of padding '' in the middle of a sentence. Format it to check that everything pretty-prints in a valid way. -```ucm -.> debug.format +``` ucm +scratch/main> debug.format ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u otherDoc : a -> Doc2 otherDoc _ = {{ yo }} diff --git a/unison-src/transcripts/doc2markdown.md b/unison-src/transcripts/doc2markdown.md index a7ac7a808b..89b068a297 100644 --- a/unison-src/transcripts/doc2markdown.md +++ b/unison-src/transcripts/doc2markdown.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -86,11 +86,11 @@ Table ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> debug.doc-to-markdown fulldoc +scratch/main> debug.doc-to-markdown fulldoc ``` You can add docs to a term or type with a top-level doc literal above the binding: diff --git a/unison-src/transcripts/doc2markdown.output.md b/unison-src/transcripts/doc2markdown.output.md index c9b98f984f..d8a6b69428 100644 --- a/unison-src/transcripts/doc2markdown.output.md +++ b/unison-src/transcripts/doc2markdown.output.md @@ -1,4 +1,4 @@ -```unison +``` unison otherDoc : a -> Doc2 otherDoc _ = {{ yo }} @@ -81,8 +81,8 @@ Table }} ``` -```ucm -.> debug.doc-to-markdown fulldoc +``` ucm +scratch/main> debug.doc-to-markdown fulldoc Heres some text with a soft line break @@ -159,7 +159,7 @@ Table ``` You can add docs to a term or type with a top-level doc literal above the binding: -```unison +``` unison {{ This is a term doc }} myTerm = 10 @@ -174,7 +174,7 @@ unique type MyUniqueType = MyUniqueType structural type MyStructuralType = MyStructuralType ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md index a256f4e45e..9e369c57ca 100644 --- a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md +++ b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md @@ -1,14 +1,14 @@ If `foo#old` exists in old, and `foo#new` exists in new, you might think `upgrade old new` would rewrite references to -`#old` with references to `#new`. And it will... !!unless!! `#old` still exists in new. +`#old` with references to `#new`. And it will... \!\!unless\!\! `#old` still exists in new. -```unison +``` unison lib.old.foo = 18 lib.new.other = 18 lib.new.foo = 19 mything = lib.old.foo + lib.old.foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ mything = lib.old.foo + lib.old.foo mything : Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/duplicate-names.md b/unison-src/transcripts/duplicate-names.md index 2935a401b9..d40cc9e821 100644 --- a/unison-src/transcripts/duplicate-names.md +++ b/unison-src/transcripts/duplicate-names.md @@ -1,7 +1,7 @@ # Duplicate names in scratch file. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Term and ability constructor collisions should cause a parse error. @@ -49,6 +49,6 @@ X = () ``` ```ucm -.> add -.> view X +scratch/main> add +scratch/main> view X ``` diff --git a/unison-src/transcripts/duplicate-names.output.md b/unison-src/transcripts/duplicate-names.output.md index 7e82b2e04b..7e1e838515 100644 --- a/unison-src/transcripts/duplicate-names.output.md +++ b/unison-src/transcripts/duplicate-names.output.md @@ -2,7 +2,7 @@ Term and ability constructor collisions should cause a parse error. -```unison +``` unison structural ability Stream where send : a -> () @@ -10,7 +10,7 @@ Stream.send : a -> () Stream.send _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,14 +26,14 @@ Stream.send _ = () ``` Term and type constructor collisions should cause a parse error. -```unison +``` unison structural type X = x X.x : a -> () X.x _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,13 +49,13 @@ X.x _ = () ``` Ability and type constructor collisions should cause a parse error. -```unison +``` unison structural type X = x structural ability X where x : () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -69,14 +69,14 @@ structural ability X where ``` Field accessors and terms with the same name should cause a parse error. -```unison +``` unison structural type X = {x : ()} X.x.modify = () X.x.set = () X.x = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -103,13 +103,13 @@ X.x = () ``` Types and terms with the same name are allowed. -```unison +``` unison structural type X = Z X = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -124,8 +124,8 @@ X = () X : () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -133,7 +133,7 @@ X = () (also named builtin.Unit) X : () -.> view X +scratch/main> view X structural type X = Z diff --git a/unison-src/transcripts/duplicate-term-detection.md b/unison-src/transcripts/duplicate-term-detection.md index 61b2a8ebf1..3df20584b7 100644 --- a/unison-src/transcripts/duplicate-term-detection.md +++ b/unison-src/transcripts/duplicate-term-detection.md @@ -1,7 +1,7 @@ # Duplicate Term Detection ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` diff --git a/unison-src/transcripts/duplicate-term-detection.output.md b/unison-src/transcripts/duplicate-term-detection.output.md index 35f4de11fc..b726a6a94d 100644 --- a/unison-src/transcripts/duplicate-term-detection.output.md +++ b/unison-src/transcripts/duplicate-term-detection.output.md @@ -2,12 +2,12 @@ Trivial duplicate terms should be detected: -```unison +``` unison x = 1 x = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,12 +21,12 @@ x = 2 ``` Equivalent duplicate terms should be detected: -```unison +``` unison x = 1 x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -40,14 +40,14 @@ x = 1 ``` Duplicates from record accessors/setters should be detected -```unison +``` unison structural type Record = {x: Nat, y: Nat} Record.x = 1 Record.x.set = 2 Record.x.modify = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -74,7 +74,7 @@ Record.x.modify = 2 ``` Duplicate terms and constructors should be detected: -```unison +``` unison structural type SumType = X SumType.X = 1 @@ -85,7 +85,7 @@ structural ability AnAbility where AnAbility.thing = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/ed25519.md b/unison-src/transcripts/ed25519.md index 679a8900a0..b7f7860c98 100644 --- a/unison-src/transcripts/ed25519.md +++ b/unison-src/transcripts/ed25519.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/ed25519.output.md b/unison-src/transcripts/ed25519.output.md index e204f75302..0647c3199f 100644 --- a/unison-src/transcripts/ed25519.output.md +++ b/unison-src/transcripts/ed25519.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison up = 0xs0123456789abcdef down = 0xsfedcba9876543210 @@ -20,7 +19,7 @@ sigOkay = match signature with > sigOkay ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/edit-command.md b/unison-src/transcripts/edit-command.md index 4c4edc9e4c..106b28fea4 100644 --- a/unison-src/transcripts/edit-command.md +++ b/unison-src/transcripts/edit-command.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison /private/tmp/scratch.u @@ -11,11 +11,11 @@ mytest = [Ok "ok"] ``` ```ucm -.> add -.> edit foo bar -.> edit mytest +scratch/main> add +scratch/main> edit foo bar +scratch/main> edit mytest ``` ```ucm:error -.> edit missing +scratch/main> edit missing ``` diff --git a/unison-src/transcripts/edit-command.output.md b/unison-src/transcripts/edit-command.output.md index a4c428e281..e13d5cea9c 100644 --- a/unison-src/transcripts/edit-command.output.md +++ b/unison-src/transcripts/edit-command.output.md @@ -1,10 +1,10 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison --- title: /private/tmp/scratch.u --- @@ -16,8 +16,7 @@ mytest = [Ok "ok"] ``` - -```ucm +``` ucm Loading changes detected in /private/tmp/scratch.u. @@ -32,8 +31,8 @@ mytest = [Ok "ok"] mytest : [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -41,7 +40,7 @@ mytest = [Ok "ok"] foo : Nat mytest : [Result] -.> edit foo bar +scratch/main> edit foo bar ☝️ @@ -50,7 +49,7 @@ mytest = [Ok "ok"] You can edit them there, then run `update` to replace the definitions currently in this namespace. -.> edit mytest +scratch/main> edit mytest ☝️ @@ -60,7 +59,7 @@ mytest = [Ok "ok"] definitions currently in this namespace. ``` -```unison:added-by-ucm /private/tmp/scratch.u +``` unison:added-by-ucm /private/tmp/scratch.u bar : Nat bar = 456 @@ -68,12 +67,12 @@ foo : Nat foo = 123 ``` -```unison:added-by-ucm /private/tmp/scratch.u +``` unison:added-by-ucm /private/tmp/scratch.u test> mytest = [Ok "ok"] ``` -```ucm -.> edit missing +``` ucm +scratch/main> edit missing ⚠️ diff --git a/unison-src/transcripts/edit-namespace.output.md b/unison-src/transcripts/edit-namespace.output.md index ab3bbbb54a..452a5d3889 100644 --- a/unison-src/transcripts/edit-namespace.output.md +++ b/unison-src/transcripts/edit-namespace.output.md @@ -1,4 +1,4 @@ -```unison +``` unison {{ ping doc }} nested.cycle.ping n = n Nat.+ pong n @@ -17,7 +17,7 @@ lib.project.ignoreMe = 30 unique type Foo = { bar : Nat, baz : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ unique type Foo = { bar : Nat, baz : Nat } toplevel : Text ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -68,7 +68,7 @@ project/main> add ``` `edit.namespace` edits the whole namespace (minus the top-level `lib`). -```ucm +``` ucm project/main> edit.namespace ☝️ @@ -79,7 +79,7 @@ project/main> edit.namespace definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u type Foo = { bar : Nat, baz : Nat } nested.cycle.ping : Nat -> Nat @@ -110,7 +110,7 @@ toplevel = "hi" `edit.namespace` can also accept explicit paths -```ucm +``` ucm project/main> edit.namespace nested simple ☝️ @@ -121,7 +121,7 @@ project/main> edit.namespace nested simple definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u nested.cycle.ping : Nat -> Nat nested.cycle.ping n = use Nat + diff --git a/unison-src/transcripts/empty-namespaces.md b/unison-src/transcripts/empty-namespaces.md index 223ab34ba9..ff9cb042dc 100644 --- a/unison-src/transcripts/empty-namespaces.md +++ b/unison-src/transcripts/empty-namespaces.md @@ -5,19 +5,19 @@ mynamespace.x = 1 ``` ```ucm:hide -.> add -.> delete.namespace mynamespace +scratch/main> add +scratch/main> delete.namespace mynamespace ``` The deleted namespace shouldn't appear in `ls` output. ```ucm:error -.> ls +scratch/main> ls ``` ```ucm:error -.> find.verbose +scratch/main> find.verbose ``` ```ucm:error -.> find mynamespace +scratch/main> find mynamespace ``` ## history @@ -25,15 +25,7 @@ The deleted namespace shouldn't appear in `ls` output. The history of the namespace should be empty. ```ucm -.> history mynamespace -``` - -Merging an empty namespace should be a no-op - -```ucm:error -.empty> history -.empty> merge.old .mynamespace -.empty> history +scratch/main> history mynamespace ``` Add and then delete a term to add some history to a deleted namespace. @@ -44,8 +36,8 @@ stuff.thing = 2 ``` ```ucm:hide -.> add -.> delete.namespace deleted +scratch/main> add +scratch/main> delete.namespace deleted ``` ## fork @@ -53,14 +45,14 @@ stuff.thing = 2 I should be allowed to fork over a deleted namespace ```ucm -.> fork stuff deleted +scratch/main> fork stuff deleted ``` The history from the `deleted` namespace should have been overwritten by the history from `stuff`. ```ucm -.> history stuff -.> history deleted +scratch/main> history stuff +scratch/main> history deleted ``` ## move.namespace @@ -71,15 +63,15 @@ moveme.y = 2 ``` ```ucm:hide -.> add +scratch/main> add ``` I should be able to move a namespace over-top of a deleted namespace. The history should be that of the moved namespace. ```ucm -.> delete.namespace moveoverme -.> history moveme -.> move.namespace moveme moveoverme -.> history moveoverme +scratch/main> delete.namespace moveoverme +scratch/main> history moveme +scratch/main> move.namespace moveme moveoverme +scratch/main> history moveoverme ``` diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 16d33046e1..1b598b6dd4 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -1,18 +1,19 @@ # Empty namespace behaviours -```unison +``` unison mynamespace.x = 1 ``` The deleted namespace shouldn't appear in `ls` output. -```ucm -.> ls + +``` ucm +scratch/main> ls nothing to show ``` -```ucm -.> find.verbose +``` ucm +scratch/main> find.verbose ☝️ @@ -28,8 +29,8 @@ The deleted namespace shouldn't appear in `ls` output. namespace. ``` -```ucm -.> find mynamespace +``` ucm +scratch/main> find mynamespace ☝️ @@ -49,35 +50,20 @@ The deleted namespace shouldn't appear in `ls` output. The history of the namespace should be empty. -```ucm -.> history mynamespace - - ☝️ The namespace .mynamespace is empty. - -``` -Merging an empty namespace should be a no-op - -```ucm - ☝️ The namespace .empty is empty. - -.empty> history - - ☝️ The namespace .empty is empty. +``` ucm +scratch/main> history mynamespace -.empty> merge.old .mynamespace - - ⚠️ + Note: The most recent namespace hash is immediately below this + message. - The namespace .mynamespace doesn't exist. - -.empty> history - - ☝️ The namespace .empty is empty. + + + □ 1. #sg60bvjo91 (start of history) ``` Add and then delete a term to add some history to a deleted namespace. -```unison +``` unison deleted.x = 1 stuff.thing = 2 ``` @@ -86,16 +72,16 @@ stuff.thing = 2 I should be allowed to fork over a deleted namespace -```ucm -.> fork stuff deleted +``` ucm +scratch/main> fork stuff deleted Done. ``` The history from the `deleted` namespace should have been overwritten by the history from `stuff`. -```ucm -.> history stuff +``` ucm +scratch/main> history stuff Note: The most recent namespace hash is immediately below this message. @@ -104,7 +90,7 @@ The history from the `deleted` namespace should have been overwritten by the his □ 1. #q2dq4tsno1 (start of history) -.> history deleted +scratch/main> history deleted Note: The most recent namespace hash is immediately below this message. @@ -116,7 +102,7 @@ The history from the `deleted` namespace should have been overwritten by the his ``` ## move.namespace -```unison +``` unison moveoverme.x = 1 moveme.y = 2 ``` @@ -124,12 +110,12 @@ moveme.y = 2 I should be able to move a namespace over-top of a deleted namespace. The history should be that of the moved namespace. -```ucm -.> delete.namespace moveoverme +``` ucm +scratch/main> delete.namespace moveoverme Done. -.> history moveme +scratch/main> history moveme Note: The most recent namespace hash is immediately below this message. @@ -138,11 +124,11 @@ The history should be that of the moved namespace. □ 1. #c5uisu4kll (start of history) -.> move.namespace moveme moveoverme +scratch/main> move.namespace moveme moveoverme Done. -.> history moveoverme +scratch/main> history moveoverme Note: The most recent namespace hash is immediately below this message. diff --git a/unison-src/transcripts/emptyCodebase.md b/unison-src/transcripts/emptyCodebase.md index a9ea55b850..03b4e44e9e 100644 --- a/unison-src/transcripts/emptyCodebase.md +++ b/unison-src/transcripts/emptyCodebase.md @@ -7,21 +7,21 @@ Not even `Nat` or `+`! BEHOLD!!! ```ucm:error -.> ls +scratch/main> ls ``` Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: ```ucm -.foo> builtins.merge -.foo> ls +scratch/main> builtins.merge lib.builtins +scratch/main> ls lib ``` And for a limited time, you can get even more builtin goodies: ```ucm -.foo> builtins.mergeio -.foo> ls +scratch/main> builtins.mergeio lib.builtinsio +scratch/main> ls lib ``` More typically, you'd start out by pulling `base`. diff --git a/unison-src/transcripts/emptyCodebase.output.md b/unison-src/transcripts/emptyCodebase.output.md index 672ac4857a..86c4b63ff2 100644 --- a/unison-src/transcripts/emptyCodebase.output.md +++ b/unison-src/transcripts/emptyCodebase.output.md @@ -2,40 +2,40 @@ The Unison codebase, when first initialized, contains no definitions in its namespace. -Not even `Nat` or `+`! +Not even `Nat` or `+`\! -BEHOLD!!! +BEHOLD\!\!\! -```ucm -.> ls +``` ucm +scratch/main> ls nothing to show ``` Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: -```ucm - ☝️ The namespace .foo is empty. - -.foo> builtins.merge +``` ucm +scratch/main> builtins.merge lib.builtins Done. -.foo> ls +scratch/main> ls lib - 1. builtin/ (469 terms, 74 types) + 1. builtins/ (469 terms, 74 types) ``` And for a limited time, you can get even more builtin goodies: -```ucm -.foo> builtins.mergeio +``` ucm +scratch/main> builtins.mergeio lib.builtinsio Done. -.foo> ls +scratch/main> ls lib - 1. builtin/ (643 terms, 92 types) + 1. builtins/ (469 terms, 74 types) + 2. builtinsio/ (643 terms, 92 types) ``` -More typically, you'd start out by pulling `base. +More typically, you'd start out by pulling `base`. + diff --git a/unison-src/transcripts/error-messages.md b/unison-src/transcripts/error-messages.md index de58eb43b9..8490e491a2 100644 --- a/unison-src/transcripts/error-messages.md +++ b/unison-src/transcripts/error-messages.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This file contains programs with parse errors and type errors, for visual inspection of error message quality and to check for regressions or changes to error reporting. diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index 525df31ee9..0b3e334aa6 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -1,4 +1,3 @@ - This file contains programs with parse errors and type errors, for visual inspection of error message quality and to check for regressions or changes to error reporting. ## Parse errors @@ -7,11 +6,11 @@ Some basic errors of literals. ### Floating point literals -```unison +``` unison x = 1. -- missing some digits after the decimal ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,15 +18,15 @@ x = 1. -- missing some digits after the decimal 1 | x = 1. -- missing some digits after the decimal - I was expecting some digits after the '.', for example: 1.0 or - 1.1e37. + I was expecting some digits after the `.` , for example: `1.0` + or `1.1e37`. ``` -```unison +``` unison x = 1e -- missing an exponent ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,14 +35,14 @@ x = 1e -- missing an exponent 1 | x = 1e -- missing an exponent I was expecting some digits for the exponent, for example: - 1e37. + `1e37`. ``` -```unison +``` unison x = 1e- -- missing an exponent ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -52,14 +51,14 @@ x = 1e- -- missing an exponent 1 | x = 1e- -- missing an exponent I was expecting some digits for the exponent, for example: - 1e-37. + `1e-37`. ``` -```unison +``` unison x = 1E+ -- missing an exponent ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -68,16 +67,16 @@ x = 1E+ -- missing an exponent 1 | x = 1E+ -- missing an exponent I was expecting some digits for the exponent, for example: - 1e+37. + `1e+37`. ``` ### Hex, octal, and bytes literals -```unison +``` unison x = 0xoogabooga -- invalid hex chars ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -89,11 +88,11 @@ x = 0xoogabooga -- invalid hex chars 0123456789abcdefABCDEF) after the 0x. ``` -```unison +``` unison x = 0o987654321 -- 9 and 8 are not valid octal char ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -105,11 +104,11 @@ x = 0o987654321 -- 9 and 8 are not valid octal char the 0o. ``` -```unison +``` unison x = 0xsf -- odd number of hex chars in a bytes literal ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -121,11 +120,11 @@ x = 0xsf -- odd number of hex chars in a bytes literal of 0123456789abcdefABCDEF) after the 0xs. ``` -```unison +``` unison x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -139,11 +138,11 @@ x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal ``` ### Layout errors -```unison +``` unison foo = else -- not matching if ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -153,11 +152,11 @@ foo = else -- not matching if ``` -```unison +``` unison foo = then -- unclosed ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -167,11 +166,11 @@ foo = then -- unclosed ``` -```unison +``` unison foo = with -- unclosed ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -183,12 +182,12 @@ foo = with -- unclosed ``` ### Matching -```unison +``` unison -- No cases foo = match 1 with ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -201,12 +200,12 @@ foo = match 1 with ``` -```unison +``` unison foo = match 1 with 2 -- no right-hand-side ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -222,14 +221,14 @@ foo = match 1 with * pattern guard ``` -```unison +``` unison -- Mismatched arities foo = cases 1, 2 -> () 3 -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -243,7 +242,7 @@ foo = cases ``` -```unison +``` unison -- Missing a '->' x = match Some a with None -> @@ -252,7 +251,7 @@ x = match Some a with 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -271,7 +270,7 @@ x = match Some a with * true ``` -```unison +``` unison -- Missing patterns x = match Some a with None -> 1 @@ -279,7 +278,7 @@ x = match Some a with -> 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -294,14 +293,14 @@ x = match Some a with * newline or semicolon ``` -```unison +``` unison -- Guards following an unguarded case x = match Some a with None -> 1 | true -> 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -318,12 +317,12 @@ x = match Some a with ``` ### Watches -```unison +``` unison -- Empty watch > ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -335,26 +334,28 @@ x = match Some a with ``` ### Keywords -```unison +``` unison use.keyword.in.namespace = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. - The identifier used here isn't allowed to be a reserved keyword: + The identifier `namespace` used here is a reserved keyword: 1 | use.keyword.in.namespace = 1 + You can avoid this problem either by renaming the identifier + or wrapping it in backticks (like `namespace` ). ``` -```unison +``` unison -- reserved operator a ! b = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/errors/missing-result-typed.md b/unison-src/transcripts/errors/missing-result-typed.md index 47a3eb7920..c61c2ccef7 100644 --- a/unison-src/transcripts/errors/missing-result-typed.md +++ b/unison-src/transcripts/errors/missing-result-typed.md @@ -6,7 +6,7 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide:all diff --git a/unison-src/transcripts/errors/missing-result-typed.output.md b/unison-src/transcripts/errors/missing-result-typed.output.md index 260b806172..2357371eca 100644 --- a/unison-src/transcripts/errors/missing-result-typed.output.md +++ b/unison-src/transcripts/errors/missing-result-typed.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison a : Nat a = b = 24 diff --git a/unison-src/transcripts/errors/missing-result.output.md b/unison-src/transcripts/errors/missing-result.output.md index c099e70080..608f5c589e 100644 --- a/unison-src/transcripts/errors/missing-result.output.md +++ b/unison-src/transcripts/errors/missing-result.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison x = y = 24 ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all-error.md b/unison-src/transcripts/errors/ucm-hide-all-error.md index dcf94d8d32..5952056f48 100644 --- a/unison-src/transcripts/errors/ucm-hide-all-error.md +++ b/unison-src/transcripts/errors/ucm-hide-all-error.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide:all:error -.> history +scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all-error.output.md b/unison-src/transcripts/errors/ucm-hide-all-error.output.md index e3a9558abd..de409c16f8 100644 --- a/unison-src/transcripts/errors/ucm-hide-all-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all-error.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an expected error is not encountered in a `ucm:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```ucm -.> history +``` ucm +scratch/main> history ``` + 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/ucm-hide-all.md b/unison-src/transcripts/errors/ucm-hide-all.md index 22950a9334..dd4b963dfa 100644 --- a/unison-src/transcripts/errors/ucm-hide-all.md +++ b/unison-src/transcripts/errors/ucm-hide-all.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide:all -.> move.namespace foo bar +scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all.output.md b/unison-src/transcripts/errors/ucm-hide-all.output.md index 38ec6f09f5..34b9b974a4 100644 --- a/unison-src/transcripts/errors/ucm-hide-all.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an error is encountered in a `ucm:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```ucm -.> move.namespace foo bar +``` ucm +scratch/main> move.namespace foo bar ``` + 🛑 The transcript failed due to an error in the stanza above. The error is: diff --git a/unison-src/transcripts/errors/ucm-hide-error.md b/unison-src/transcripts/errors/ucm-hide-error.md index 68da57efc2..9b338dfd96 100644 --- a/unison-src/transcripts/errors/ucm-hide-error.md +++ b/unison-src/transcripts/errors/ucm-hide-error.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide:error -.> history +scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide-error.output.md b/unison-src/transcripts/errors/ucm-hide-error.output.md index 0056a35888..893baf53e5 100644 --- a/unison-src/transcripts/errors/ucm-hide-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-error.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an expected error is not encountered in a `ucm:hide` block then the transcript parser should print the stanza and surface a helpful message. -```ucm -.> history +``` ucm +scratch/main> history ``` + 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/ucm-hide.md b/unison-src/transcripts/errors/ucm-hide.md index aa725ada4c..470c610b52 100644 --- a/unison-src/transcripts/errors/ucm-hide.md +++ b/unison-src/transcripts/errors/ucm-hide.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide -.> move.namespace foo bar +scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/errors/ucm-hide.output.md b/unison-src/transcripts/errors/ucm-hide.output.md index fe4faa583d..2058708696 100644 --- a/unison-src/transcripts/errors/ucm-hide.output.md +++ b/unison-src/transcripts/errors/ucm-hide.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an error is encountered in a `ucm:hide` block then the transcript parser should print the stanza and surface a helpful message. -```ucm -.> move.namespace foo bar +``` ucm +scratch/main> move.namespace foo bar ``` + 🛑 The transcript failed due to an error in the stanza above. The error is: diff --git a/unison-src/transcripts/errors/unison-hide-all-error.output.md b/unison-src/transcripts/errors/unison-hide-all-error.output.md index 3c3e6f3e5f..fbb8a35d63 100644 --- a/unison-src/transcripts/errors/unison-hide-all-error.output.md +++ b/unison-src/transcripts/errors/unison-hide-all-error.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an expected error is not encountered in a `unison:hide:all:error` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison myVal = 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide-all.output.md b/unison-src/transcripts/errors/unison-hide-all.output.md index 9b313c82a6..a093b5f5ec 100644 --- a/unison-src/transcripts/errors/unison-hide-all.output.md +++ b/unison-src/transcripts/errors/unison-hide-all.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison g 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide-error.output.md b/unison-src/transcripts/errors/unison-hide-error.output.md index 30ab85dc58..bde72516fe 100644 --- a/unison-src/transcripts/errors/unison-hide-error.output.md +++ b/unison-src/transcripts/errors/unison-hide-error.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an expected error is not encountered in a `unison:hide:error` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison myVal = 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide.output.md b/unison-src/transcripts/errors/unison-hide.output.md index bf410ca30e..1a8a9c78a9 100644 --- a/unison-src/transcripts/errors/unison-hide.output.md +++ b/unison-src/transcripts/errors/unison-hide.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison g 3 ``` diff --git a/unison-src/transcripts/escape-sequences.output.md b/unison-src/transcripts/escape-sequences.output.md index 46cb0e0459..955b6e8fe6 100644 --- a/unison-src/transcripts/escape-sequences.output.md +++ b/unison-src/transcripts/escape-sequences.output.md @@ -1,10 +1,10 @@ -```unison +``` unison > "Rúnar" > "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" > "古池や蛙飛びこむ水の音" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/find-by-type.md b/unison-src/transcripts/find-by-type.md index 009ad845e5..ec6dd3f954 100644 --- a/unison-src/transcripts/find-by-type.md +++ b/unison-src/transcripts/find-by-type.md @@ -1,5 +1,5 @@ ```ucm:hide -.> alias.type ##Text builtin.Text +scratch/main> alias.type ##Text builtin.Text ``` ```unison:hide @@ -17,11 +17,11 @@ baz = cases ``` ```ucm -.> add -.> find : Text -> A -.> find : A -> Text -.> find : A +scratch/main> add +scratch/main> find : Text -> A +scratch/main> find : A -> Text +scratch/main> find : A ``` ```ucm:error -.> find : Text +scratch/main> find : Text ``` diff --git a/unison-src/transcripts/find-by-type.output.md b/unison-src/transcripts/find-by-type.output.md index 0577051f92..c45fcd6a88 100644 --- a/unison-src/transcripts/find-by-type.output.md +++ b/unison-src/transcripts/find-by-type.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type A = A Text foo : A @@ -12,8 +12,8 @@ baz = cases A t -> t ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -22,25 +22,25 @@ baz = cases baz : A -> Text foo : A -.> find : Text -> A +scratch/main> find : Text -> A 1. bar : Text -> A 2. A.A : Text -> A -.> find : A -> Text +scratch/main> find : A -> Text 1. baz : A -> Text -.> find : A +scratch/main> find : A 1. foo : A ``` -```ucm -.> find : Text +``` ucm +scratch/main> find : Text ☝️ diff --git a/unison-src/transcripts/find-command.md b/unison-src/transcripts/find-command.md index 46f852dd35..019903556a 100644 --- a/unison-src/transcripts/find-command.md +++ b/unison-src/transcripts/find-command.md @@ -1,6 +1,5 @@ ```ucm:hide -.> builtins.merge -.> move builtin lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison:hide @@ -14,37 +13,36 @@ somewhere.bar = 7 ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> find foo -.> view 1 -.> find.all foo -.> view 1 +scratch/main> find foo +scratch/main> view 1 +scratch/main> find.all foo +scratch/main> view 1 ``` ```ucm -.> find-in cat foo -.> view 1 -.> find-in.all cat foo -.> view 1 +scratch/main> find-in cat foo +scratch/main> view 1 +scratch/main> find-in.all cat foo +scratch/main> view 1 ``` -```ucm -.somewhere> find bar -.somewhere> find.global bar -``` +Finding within a namespace ```ucm -.> find bar -.> find-in somewhere bar +scratch/main> find bar +-- Shows UUIDs +-- scratch/main> find.global bar +scratch/main> find-in somewhere bar ``` ```ucm:error -.> find baz +scratch/main> find baz ``` ```ucm:error -.> find.global notHere +scratch/main> find.global notHere ``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index f3a11b8913..7abbe26f0d 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -1,4 +1,4 @@ -```unison +``` unison foo = 1 lib.foo = 2 lib.bar = 3 @@ -8,19 +8,19 @@ cat.lib.bar = 6 somewhere.bar = 7 ``` -```ucm -.> find foo +``` ucm +scratch/main> find foo 1. cat.foo : Nat 2. foo : Nat -.> view 1 +scratch/main> view 1 cat.foo : Nat cat.foo = 4 -.> find.all foo +scratch/main> find.all foo 1. cat.foo : Nat 2. cat.lib.foo : Nat @@ -28,63 +28,53 @@ somewhere.bar = 7 4. foo : Nat -.> view 1 +scratch/main> view 1 cat.foo : Nat cat.foo = 4 ``` -```ucm -.> find-in cat foo +``` ucm +scratch/main> find-in cat foo 1. foo : Nat -.> view 1 +scratch/main> view 1 cat.foo : Nat cat.foo = 4 -.> find-in.all cat foo +scratch/main> find-in.all cat foo 1. lib.foo : Nat 2. foo : Nat -.> view 1 +scratch/main> view 1 cat.lib.foo : Nat cat.lib.foo = 5 ``` -```ucm -.somewhere> find bar +Finding within a namespace - 1. bar : ##Nat - - -.somewhere> find.global bar - - 1. .cat.lib.bar : Nat - 2. .lib.bar : Nat - 3. .somewhere.bar : Nat - - -``` -```ucm -.> find bar +``` ucm +scratch/main> find bar 1. somewhere.bar : Nat -.> find-in somewhere bar +-- Shows UUIDs +-- scratch/main> find.global bar +scratch/main> find-in somewhere bar 1. bar : Nat ``` -```ucm -.> find baz +``` ucm +scratch/main> find baz ☝️ @@ -100,8 +90,8 @@ somewhere.bar = 7 namespace. ``` -```ucm -.> find.global notHere +``` ucm +scratch/main> find.global notHere 😶 diff --git a/unison-src/transcripts/fix-1381-excess-propagate.md b/unison-src/transcripts/fix-1381-excess-propagate.md index 84da98c5bc..e7314c9bd7 100644 --- a/unison-src/transcripts/fix-1381-excess-propagate.md +++ b/unison-src/transcripts/fix-1381-excess-propagate.md @@ -7,7 +7,7 @@ X.foo = "a namespace" ``` ```ucm -.> add +scratch/main> add ``` Here is an update which should not affect `X`: @@ -15,14 +15,14 @@ Here is an update which should not affect `X`: a = "an update" ``` ```ucm -.> update +scratch/main> update ``` As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; ```ucm -.> history X +scratch/main> history X ``` however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: ```ucm:error -.> history #7nl6ppokhg +scratch/main> history #7nl6ppokhg ``` diff --git a/unison-src/transcripts/fix-1381-excess-propagate.output.md b/unison-src/transcripts/fix-1381-excess-propagate.output.md index f07217266b..edc30e9f25 100644 --- a/unison-src/transcripts/fix-1381-excess-propagate.output.md +++ b/unison-src/transcripts/fix-1381-excess-propagate.output.md @@ -1,13 +1,14 @@ We were seeing an issue where (it seemed) that every namespace that was visited during a propagate would get a new history node, even when it didn't contain any dependents. Example: -```unison + +``` unison a = "a term" X.foo = "a namespace" ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -16,12 +17,13 @@ X.foo = "a namespace" ``` Here is an update which should not affect `X`: -```unison + +``` unison a = "an update" ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -30,8 +32,9 @@ a = "an update" ``` As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; -```ucm -.> history X + +``` ucm +scratch/main> history X Note: The most recent namespace hash is immediately below this message. @@ -42,8 +45,9 @@ As of the time of this writing, the history for `X` should be a single node, `#4 ``` however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: -```ucm -.> history #7nl6ppokhg + +``` ucm +scratch/main> history #7nl6ppokhg 😶 diff --git a/unison-src/transcripts/fix-2258-if-as-list-element.md b/unison-src/transcripts/fix-2258-if-as-list-element.md index fbf9cc93dd..1ebc3a2250 100644 --- a/unison-src/transcripts/fix-2258-if-as-list-element.md +++ b/unison-src/transcripts/fix-2258-if-as-list-element.md @@ -1,7 +1,7 @@ Tests that `if` statements can appear as list and tuple elements. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide diff --git a/unison-src/transcripts/fix-2258-if-as-list-element.output.md b/unison-src/transcripts/fix-2258-if-as-list-element.output.md index 50c28c0046..0e136a6bee 100644 --- a/unison-src/transcripts/fix-2258-if-as-list-element.output.md +++ b/unison-src/transcripts/fix-2258-if-as-list-element.output.md @@ -1,6 +1,6 @@ Tests that `if` statements can appear as list and tuple elements. -```unison +``` unison > [ if true then 1 else 0 ] > [ if true then 1 else 0, 1] diff --git a/unison-src/transcripts/fix-big-list-crash.md b/unison-src/transcripts/fix-big-list-crash.md index 22be8f0cb1..70c056515d 100644 --- a/unison-src/transcripts/fix-big-list-crash.md +++ b/unison-src/transcripts/fix-big-list-crash.md @@ -1,7 +1,7 @@ #### Big list crash ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Big lists have been observed to crash, while in the garbage collection step. diff --git a/unison-src/transcripts/fix-big-list-crash.output.md b/unison-src/transcripts/fix-big-list-crash.output.md index 1d14e77d7b..f6db0fb0bb 100644 --- a/unison-src/transcripts/fix-big-list-crash.output.md +++ b/unison-src/transcripts/fix-big-list-crash.output.md @@ -2,13 +2,13 @@ Big lists have been observed to crash, while in the garbage collection step. -```unison +``` unison unique type Direction = U | D | L | R x = [(R,1005),(U,563),(R,417),(U,509),(L,237),(U,555),(R,397),(U,414),(L,490),(U,336),(L,697),(D,682),(L,180),(U,951),(L,189),(D,547),(R,697),(U,583),(L,172),(D,859),(L,370),(D,114),(L,519),(U,829),(R,389),(U,608),(R,66),(D,634),(L,320),(D,49),(L,931),(U,137),(L,349),(D,689),(L,351),(D,829),(R,819),(D,138),(L,118),(D,849),(R,230),(U,858),(L,509),(D,311),(R,815),(U,217),(R,359),(U,840),(R,77),(U,230),(R,361),(U,322),(R,300),(D,646),(R,348),(U,815),(R,793),(D,752),(R,967),(U,128),(R,948),(D,499),(R,359),(U,572),(L,566),(U,815),(R,630),(D,290),(L,829),(D,736),(R,358),(U,778),(R,891),(U,941),(R,544),(U,889),(L,920),(U,913),(L,447),(D,604),(R,538),(U,818),(L,215),(D,437),(R,447),(U,576),(R,452),(D,794),(R,864),(U,269),(L,325),(D,35),(L,268),(D,639),(L,101),(U,777),(L,776),(U,958),(R,105),(U,517),(R,667),(D,423),(R,603),(U,469),(L,125),(D,919),(R,879),(U,994),(R,665),(D,377),(R,456),(D,570),(L,685),(U,291),(R,261),(U,846),(R,840),(U,418),(L,974),(D,270),(L,312),(D,426),(R,621),(D,334),(L,855),(D,378),(R,694),(U,845),(R,481),(U,895),(L,362),(D,840),(L,712),(U,57),(R,276),(D,643),(R,566),(U,348),(R,361),(D,144),(L,287),(D,864),(L,556),(U,610),(L,927),(U,322),(R,271),(D,90),(L,741),(U,446),(R,181),(D,527),(R,56),(U,805),(L,907),(D,406),(L,286),(U,873),(L,79),(D,280),(L,153),(D,377),(R,253),(D,61),(R,475),(D,804),(R,788),(U,393),(L,660),(U,314),(R,489),(D,491),(L,234),(D,712),(L,253),(U,651),(L,777),(D,726),(R,146),(U,47),(R,630),(U,517),(R,226),(U,624),(L,834),(D,153),(L,513),(U,799),(R,287),(D,868),(R,982),(U,390),(L,296),(D,373),(R,9),(U,994),(R,105),(D,673),(L,657),(D,868),(R,738),(D,277),(R,374),(U,828),(R,860),(U,247),(R,484),(U,986),(L,723),(D,847),(L,578),(U,487),(L,51),(D,865),(L,328),(D,199),(R,812),(D,726),(R,355),(D,463),(R,761),(U,69),(R,508),(D,753),(L,81),(D,50),(L,345),(D,66),(L,764),(D,466),(L,975),(U,619),(R,59),(D,788),(L,737),(D,360),(R,14),(D,253),(L,512),(D,417),(R,828),(D,188),(L,394),(U,212),(R,658),(U,369),(R,920),(U,927),(L,339),(U,552),(R,856),(D,458),(R,407),(U,41),(L,930),(D,460),(R,809),(U,467),(L,410),(D,800),(L,135),(D,596),(R,678),(D,4),(L,771),(D,637),(L,876),(U,192),(L,406),(D,136),(R,666),(U,730),(R,711),(D,291),(L,586),(U,845),(R,606),(U,2),(L,228),(D,759),(R,244),(U,946),(R,948),(U,160),(R,397),(U,134),(R,188),(U,850),(R,623),(D,315),(L,219),(D,450),(R,489),(U,374),(R,299),(D,474),(L,767),(D,679),(L,160),(D,403),(L,708)] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix-ls.output.md b/unison-src/transcripts/fix-ls.output.md index 56277c6925..b99f0f5877 100644 --- a/unison-src/transcripts/fix-ls.output.md +++ b/unison-src/transcripts/fix-ls.output.md @@ -1,16 +1,16 @@ -```ucm +``` ucm test-ls/main> builtins.merge Done. ``` -```unison +``` unison foo.bar.add x y = x Int.+ y foo.bar.subtract x y = x Int.- y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ foo.bar.subtract x y = x Int.- y foo.bar.subtract : Int -> Int -> Int ``` -```ucm +``` ucm test-ls/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix1063.md b/unison-src/transcripts/fix1063.md index a7160f3564..03ea62be7e 100644 --- a/unison-src/transcripts/fix1063.md +++ b/unison-src/transcripts/fix1063.md @@ -1,7 +1,7 @@ Tests that functions named `.` are rendered correctly. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ``` unison @@ -13,7 +13,7 @@ noop = not `.` not ``` ``` ucm -.> add -.> view noop +scratch/main> add +scratch/main> view noop ``` diff --git a/unison-src/transcripts/fix1063.output.md b/unison-src/transcripts/fix1063.output.md index 80a1cc8a26..57ab0b23d8 100644 --- a/unison-src/transcripts/fix1063.output.md +++ b/unison-src/transcripts/fix1063.output.md @@ -1,6 +1,6 @@ Tests that functions named `.` are rendered correctly. -```unison +``` unison (`.`) f g x = f (g x) use Boolean not @@ -8,7 +8,7 @@ use Boolean not noop = not `.` not ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,15 +22,15 @@ noop = not `.` not noop : Boolean -> Boolean ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: `.` : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o noop : Boolean -> Boolean -.> view noop +scratch/main> view noop noop : Boolean -> Boolean noop = diff --git a/unison-src/transcripts/fix1334.md b/unison-src/transcripts/fix1334.md index 68e6967481..5ab5899aeb 100644 --- a/unison-src/transcripts/fix1334.md +++ b/unison-src/transcripts/fix1334.md @@ -5,6 +5,6 @@ With this PR, the source of an alias can be a short hash (even of a definition t Let's make some hash-only aliases, now that we can. :mad-with-power-emoji: ```ucm -.> alias.type ##Nat Cat -.> alias.term ##Nat.+ please_fix_763.+ +scratch/main> alias.type ##Nat Cat +scratch/main> alias.term ##Nat.+ please_fix_763.+ ``` diff --git a/unison-src/transcripts/fix1334.output.md b/unison-src/transcripts/fix1334.output.md index d397a51a1a..dfadcbe0ad 100644 --- a/unison-src/transcripts/fix1334.output.md +++ b/unison-src/transcripts/fix1334.output.md @@ -1,15 +1,15 @@ -Previously, the `alias.term` and `alias.type` would fail if the source argument was hash-only, and there was no way to create an alias for a definition that didn't already have a name. Also, the `replace.term` and `replace.type` _only_ worked on hashes, and they had to be _full_ hashes. +Previously, the `alias.term` and `alias.type` would fail if the source argument was hash-only, and there was no way to create an alias for a definition that didn't already have a name. Also, the `replace.term` and `replace.type` *only* worked on hashes, and they had to be *full* hashes. With this PR, the source of an alias can be a short hash (even of a definition that doesn't currently have a name in the namespace) along with a name or hash-qualified name from the current namespace as usual. Let's make some hash-only aliases, now that we can. :mad-with-power-emoji: -```ucm -.> alias.type ##Nat Cat +``` ucm +scratch/main> alias.type ##Nat Cat Done. -.> alias.term ##Nat.+ please_fix_763.+ +scratch/main> alias.term ##Nat.+ please_fix_763.+ Done. diff --git a/unison-src/transcripts/fix1390.md b/unison-src/transcripts/fix1390.md index 807cb14d25..2ef5e8ac97 100644 --- a/unison-src/transcripts/fix1390.md +++ b/unison-src/transcripts/fix1390.md @@ -1,6 +1,6 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,8 +13,8 @@ List.map f = ``` ```ucm -.> add -.> view List.map +scratch/main> add +scratch/main> view List.map ``` ```unison diff --git a/unison-src/transcripts/fix1390.output.md b/unison-src/transcripts/fix1390.output.md index 67155bde52..340a34e2ca 100644 --- a/unison-src/transcripts/fix1390.output.md +++ b/unison-src/transcripts/fix1390.output.md @@ -1,11 +1,10 @@ - -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison -- List.map : (a -> b) -> [a] -> [b] List.map f = go acc = cases @@ -14,7 +13,7 @@ List.map f = go [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,14 +26,14 @@ List.map f = List.map : (i ->{g} o) -> [i] ->{g} [o] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: List.map : (i ->{g} o) -> [i] ->{g} [o] -.> view List.map +scratch/main> view List.map List.map : (i ->{g} o) -> [i] ->{g} [o] List.map f = @@ -44,7 +43,7 @@ List.map f = go [] ``` -```unison +``` unison List.map2 : (g -> g2) -> [g] -> [g2] List.map2 f = unused = "just to give this a different hash" @@ -54,7 +53,7 @@ List.map2 f = go [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1421.md b/unison-src/transcripts/fix1421.md new file mode 100644 index 0000000000..8117928aa4 --- /dev/null +++ b/unison-src/transcripts/fix1421.md @@ -0,0 +1,8 @@ + ```ucm + scratch/main> alias.type ##Nat Nat + scratch/main> alias.term ##Nat.+ Nat.+ + ``` + ```unison + unique type A = A Nat + unique type B = B Nat Nat + ``` diff --git a/unison-src/transcripts/fix1421.output.md b/unison-src/transcripts/fix1421.output.md new file mode 100644 index 0000000000..0f52e9a36e --- /dev/null +++ b/unison-src/transcripts/fix1421.output.md @@ -0,0 +1,29 @@ +``` ucm +scratch/main> alias.type ##Nat Nat + + Done. + +scratch/main> alias.term ##Nat.+ Nat.+ + + Done. + +``` +``` unison +unique type A = A Nat +unique type B = B Nat Nat +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type A + type B + +``` diff --git a/unison-src/transcripts/fix1532.md b/unison-src/transcripts/fix1532.md index 6b5a07c938..fc835cc46c 100644 --- a/unison-src/transcripts/fix1532.md +++ b/unison-src/transcripts/fix1532.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` First, lets create two namespaces. `foo` and `bar`, and add some definitions. @@ -11,30 +11,30 @@ bar.z = x + y ``` ```ucm -.> add +scratch/main> add ``` Let's see what we have created... ```ucm -.> ls +scratch/main> ls ``` Now, if we try deleting the namespace `foo`, we get an error, as expected. ```ucm:error -.> delete.namespace foo +scratch/main> delete.namespace foo ``` Any numbered arguments should refer to `bar.z`. ```ucm -.> debug.numberedArgs +scratch/main> debug.numberedArgs ``` We can then delete the dependent term, and then delete `foo`. ```ucm -.> delete.term 1 -.> delete.namespace foo +scratch/main> delete.term 1 +scratch/main> delete.namespace foo ``` diff --git a/unison-src/transcripts/fix1532.output.md b/unison-src/transcripts/fix1532.output.md index d2707bb51a..0412312d87 100644 --- a/unison-src/transcripts/fix1532.output.md +++ b/unison-src/transcripts/fix1532.output.md @@ -1,18 +1,18 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` First, lets create two namespaces. `foo` and `bar`, and add some definitions. -```unison +``` unison foo.x = 42 foo.y = 100 bar.z = x + y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,8 +27,8 @@ bar.z = x + y foo.y : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -39,8 +39,8 @@ bar.z = x + y ``` Let's see what we have created... -```ucm -.> ls +``` ucm +scratch/main> ls 1. bar/ (1 term) 2. builtin/ (469 terms, 74 types) @@ -49,8 +49,8 @@ Let's see what we have created... ``` Now, if we try deleting the namespace `foo`, we get an error, as expected. -```ucm -.> delete.namespace foo +``` ucm +scratch/main> delete.namespace foo ⚠️ @@ -68,8 +68,8 @@ Now, if we try deleting the namespace `foo`, we get an error, as expected. ``` Any numbered arguments should refer to `bar.z`. -```ucm -.> debug.numberedArgs +``` ucm +scratch/main> debug.numberedArgs 1. bar.z 2. bar.z @@ -77,12 +77,12 @@ Any numbered arguments should refer to `bar.z`. ``` We can then delete the dependent term, and then delete `foo`. -```ucm -.> delete.term 1 +``` ucm +scratch/main> delete.term 1 Done. -.> delete.namespace foo +scratch/main> delete.namespace foo Done. diff --git a/unison-src/transcripts/fix1578.md b/unison-src/transcripts/fix1578.md index 8e2e7958f3..809af6c161 100644 --- a/unison-src/transcripts/fix1578.md +++ b/unison-src/transcripts/fix1578.md @@ -3,7 +3,7 @@ This transcript shows how suffix-based name resolution works when definitions in ## Setup ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. @@ -16,7 +16,7 @@ foo.bar = 23 ``` ```ucm:hide -.> add +scratch/main> add ``` Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: diff --git a/unison-src/transcripts/fix1578.output.md b/unison-src/transcripts/fix1578.output.md index 1b57bcabd6..0645dae519 100644 --- a/unison-src/transcripts/fix1578.output.md +++ b/unison-src/transcripts/fix1578.output.md @@ -4,7 +4,7 @@ This transcript shows how suffix-based name resolution works when definitions in As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. -```unison +``` unison unique type Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat foo.bar : Nat @@ -13,15 +13,15 @@ foo.bar = 23 Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: -* If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. + - If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. + - Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. + - Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. ## Example 1: local file term definitions shadow codebase term definitions This should typecheck, using the file's `bar : Text` rather than the codebase `foo.bar : Nat`: -```unison +``` unison use Text ++ bar : Text @@ -32,9 +32,9 @@ baz = bar ++ ", world!" ## Example 2: any locally unique term suffix shadows codebase term definitions -This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the _codebase_). See example 4 below for overriding this behavior. +This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the *codebase*). See example 4 below for overriding this behavior. -```unison +``` unison use Text ++ oog.bar = "hello" @@ -44,7 +44,7 @@ baz = bar ++ ", world!" This subtle test establishes that we aren't using type-directed name resolution (TDNR) for the local term references in the file. If this were using TDNR, it would fail with an ambiguity as there's nothing that pins down the expected type of `bar` here: -```unison +``` unison use Text ++ oog.bar = "hello" @@ -54,7 +54,7 @@ baz = (bar, 42) This subtle test establishes that locally introduced variables (within a function, say) correctly shadow definitions introduced at the file top level: -```unison +``` unison use Text ++ oog.bar = "hello" @@ -67,7 +67,7 @@ baz bar = (bar, 42) -- here, `bar` refers to the parameter This should also typecheck, using the local `Sun`, and not `Day.Sun` which exists in the codebase, and the local `Day`, not the codebase `Day`. -```unison +``` unison structural type Zoot = Zonk | Sun structural type Day = Day Int @@ -87,7 +87,7 @@ day1 = Day +1 Even though local definitions are preferred, you can refer to definitions in the codebase via any unique suffix that doesn't also exist in the file. -```unison +``` unison structural type Zoot = Zonk | Sun use Zoot Zonk diff --git a/unison-src/transcripts/fix1696.md b/unison-src/transcripts/fix1696.md index c80b41a731..4abb83f185 100644 --- a/unison-src/transcripts/fix1696.md +++ b/unison-src/transcripts/fix1696.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:error diff --git a/unison-src/transcripts/fix1696.output.md b/unison-src/transcripts/fix1696.output.md index c0a9ccce85..772f10e6c2 100644 --- a/unison-src/transcripts/fix1696.output.md +++ b/unison-src/transcripts/fix1696.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural ability Ask where ask : Nat ability Zoot where @@ -17,7 +16,7 @@ dialog = Ask.provide 'zoot '("Awesome number: " ++ Nat.toText Ask.ask ++ "!") > dialog ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix1709.md b/unison-src/transcripts/fix1709.md similarity index 83% rename from unison-src/transcripts-using-base/fix1709.md rename to unison-src/transcripts/fix1709.md index bc254f3b24..9b0e868d02 100644 --- a/unison-src/transcripts-using-base/fix1709.md +++ b/unison-src/transcripts/fix1709.md @@ -7,7 +7,7 @@ id2 x = ``` ```ucm -.scratch> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts-using-base/fix1709.output.md b/unison-src/transcripts/fix1709.output.md similarity index 79% rename from unison-src/transcripts-using-base/fix1709.output.md rename to unison-src/transcripts/fix1709.output.md index 953121aa2c..7159b5b54b 100644 --- a/unison-src/transcripts-using-base/fix1709.output.md +++ b/unison-src/transcripts/fix1709.output.md @@ -1,4 +1,4 @@ -```unison +``` unison id x = x id2 x = @@ -6,7 +6,7 @@ id2 x = id x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -14,17 +14,14 @@ id2 x = do an `add` or `update`, here's how your codebase would change: - ⊡ Previously added definitions will be ignored: id - ⍟ These new definitions are ok to `add`: + id : x -> x id2 : x -> x ``` -```ucm - ☝️ The namespace .scratch is empty. - -.scratch> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -32,11 +29,11 @@ id2 x = id2 : x -> x ``` -```unison +``` unison > id2 "hi" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1731.md b/unison-src/transcripts/fix1731.md index 81adcd8de2..82efd3cce9 100644 --- a/unison-src/transcripts/fix1731.md +++ b/unison-src/transcripts/fix1731.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -10,7 +10,7 @@ structural ability CLI where ``` ```ucm:hide -.> add +scratch/main> add ``` The `input` here should parse as a wildcard, not as `CLI.input`. diff --git a/unison-src/transcripts/fix1731.output.md b/unison-src/transcripts/fix1731.output.md index f3fc1c35d1..be55bbb4b2 100644 --- a/unison-src/transcripts/fix1731.output.md +++ b/unison-src/transcripts/fix1731.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural ability CLI where print : Text ->{CLI} () input : {CLI} Text @@ -7,13 +6,13 @@ structural ability CLI where The `input` here should parse as a wildcard, not as `CLI.input`. -```unison +``` unison repro : Text -> () repro = cases input -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1800.md b/unison-src/transcripts/fix1800.md index a35edb8a2d..533d95d847 100644 --- a/unison-src/transcripts/fix1800.md +++ b/unison-src/transcripts/fix1800.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -26,21 +26,21 @@ Testing a few variations here: * Should be able to run annotated and unannotated main functions from the codebase. ```ucm -.> run main1 -.> run main2 -.> run main3 -.> add -.> rename.term main1 code.main1 -.> rename.term main2 code.main2 -.> rename.term main3 code.main3 +scratch/main> run main1 +scratch/main> run main2 +scratch/main> run main3 +scratch/main> add +scratch/main> rename.term main1 code.main1 +scratch/main> rename.term main2 code.main2 +scratch/main> rename.term main3 code.main3 ``` The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: ```ucm -.> run code.main1 -.> run code.main2 -.> run code.main3 +scratch/main> run code.main1 +scratch/main> run code.main2 +scratch/main> run code.main3 ``` Now testing a few variations that should NOT typecheck. @@ -56,9 +56,9 @@ main5 _ = () This shouldn't work since `main4` and `main5` don't have the right type. ```ucm:error -.> run main4 +scratch/main> run main4 ``` ```ucm:error -.> run main5 +scratch/main> run main5 ``` diff --git a/unison-src/transcripts/fix1800.output.md b/unison-src/transcripts/fix1800.output.md index 0a534138a4..97f93ed409 100644 --- a/unison-src/transcripts/fix1800.output.md +++ b/unison-src/transcripts/fix1800.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison printLine : Text ->{IO} () printLine msg = _ = putBytes.impl (stdHandle StdOut) (Text.toUtf8 (msg ++ "\n")) @@ -18,23 +17,23 @@ main3 _ = printLine "🦄 ☁️ 🌈" Testing a few variations here: -* Should be able to run annotated and unannotated main functions in the current file. -* Should be able to run annotated and unannotated main functions from the codebase. + - Should be able to run annotated and unannotated main functions in the current file. + - Should be able to run annotated and unannotated main functions from the codebase. -```ucm -.> run main1 +``` ucm +scratch/main> run main1 () -.> run main2 +scratch/main> run main2 () -.> run main3 +scratch/main> run main3 () -.> add +scratch/main> add ⍟ I've added these definitions: @@ -43,38 +42,38 @@ Testing a few variations here: main3 : '{IO} () printLine : Text ->{IO} () -.> rename.term main1 code.main1 +scratch/main> rename.term main1 code.main1 Done. -.> rename.term main2 code.main2 +scratch/main> rename.term main2 code.main2 Done. -.> rename.term main3 code.main3 +scratch/main> rename.term main3 code.main3 Done. ``` The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: -```ucm -.> run code.main1 +``` ucm +scratch/main> run code.main1 () -.> run code.main2 +scratch/main> run code.main2 () -.> run code.main3 +scratch/main> run code.main3 () ``` Now testing a few variations that should NOT typecheck. -```unison +``` unison main4 : Nat ->{IO} Nat main4 n = n @@ -84,8 +83,8 @@ main5 _ = () This shouldn't work since `main4` and `main5` don't have the right type. -```ucm -.> run main4 +``` ucm +scratch/main> run main4 😶 @@ -98,8 +97,8 @@ This shouldn't work since `main4` and `main5` don't have the right type. main4 : '{IO, Exception} result ``` -```ucm -.> run main5 +``` ucm +scratch/main> run main5 😶 diff --git a/unison-src/transcripts/fix1844.output.md b/unison-src/transcripts/fix1844.output.md index 571daa8b9a..0f6f428178 100644 --- a/unison-src/transcripts/fix1844.output.md +++ b/unison-src/transcripts/fix1844.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural type One a = One a unique type Woot a b c = Woot a b c unique type Z = Z @@ -10,7 +9,7 @@ snoc k aN = match k with > snoc (One 1) 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1926.md b/unison-src/transcripts/fix1926.md index 373cb0e95a..0ebe0e3c8f 100644 --- a/unison-src/transcripts/fix1926.md +++ b/unison-src/transcripts/fix1926.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix1926.output.md b/unison-src/transcripts/fix1926.output.md index 9eeb00583a..1c940cc22f 100644 --- a/unison-src/transcripts/fix1926.output.md +++ b/unison-src/transcripts/fix1926.output.md @@ -1,16 +1,16 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison > 'sq sq = 2934892384 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -30,13 +30,13 @@ sq = 2934892384 do sq ``` -```unison +``` unison > 'sq sq = 2934892384 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2000.md b/unison-src/transcripts/fix2000.md deleted file mode 100644 index 812ec10df0..0000000000 --- a/unison-src/transcripts/fix2000.md +++ /dev/null @@ -1,44 +0,0 @@ -Checks that squash and merge do the same thing, with nontrivial history that -includes a merge conflict. - -```ucm:hide -.> builtins.merge -``` - -```unison -x.a.p = "af" -x.a.q = "ef" -``` - -```ucm -.> add -.> fork x y -.> fork x s -.> fork x m -.> delete.verbose y.a.p -``` - -```unison -y.a.p = "fij" -``` - -```ucm -.> add -``` - -```unison -y.b.p = "wie" -``` - -Merge back into the ancestor. - -```ucm -.> add -.> merge.old y.b y.a -.> delete.term.verbose 1 -.> merge.old y m -.> merge.old.squash y s -.s> todo -.m> todo -``` - diff --git a/unison-src/transcripts/fix2000.output.md b/unison-src/transcripts/fix2000.output.md deleted file mode 100644 index 84a674b1d7..0000000000 --- a/unison-src/transcripts/fix2000.output.md +++ /dev/null @@ -1,192 +0,0 @@ -Checks that squash and merge do the same thing, with nontrivial history that -includes a merge conflict. - -```unison -x.a.p = "af" -x.a.q = "ef" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - x.a.p : Text - x.a.q : Text - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - x.a.p : Text - x.a.q : Text - -.> fork x y - - Done. - -.> fork x s - - Done. - -.> fork x m - - Done. - -.> delete.verbose y.a.p - - Name changes: - - Original Changes - 1. m.a.p ┐ 2. y.a.p (removed) - 3. s.a.p │ - 4. x.a.p │ - 5. y.a.p ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -```unison -y.a.p = "fij" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y.a.p : Text - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - y.a.p : Text - -``` -```unison -y.b.p = "wie" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y.b.p : Text - -``` -Merge back into the ancestor. - -```ucm -.> add - - ⍟ I've added these definitions: - - y.b.p : Text - -.> merge.old y.b y.a - - Here's what's changed in y.a after the merge: - - New name conflicts: - - 1. p#l2mmpgn323 : Text - ↓ - 2. ┌ p#l2mmpgn323 : Text - 3. └ p#nm3omrdks9 : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> delete.term.verbose 1 - - Resolved name conflicts: - - 1. ┌ y.a.p#l2mmpgn323 : Text - 2. └ y.a.p#nm3omrdks9 : Text - ↓ - 3. y.a.p#nm3omrdks9 : Text - - Tip: You can use `undo` or `reflog` to undo this change. - -.> merge.old y m - - Here's what's changed in m after the merge: - - Updates: - - 1. a.p : Text - ↓ - 2. a.p : Text - - Added definitions: - - 3. ┌ a.p : Text - 4. └ b.p : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash y s - - Here's what's changed in s after the merge: - - Updates: - - 1. a.p : Text - ↓ - 2. a.p : Text - - Added definitions: - - 3. ┌ a.p : Text - 4. └ b.p : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.s> todo - - ✅ - - No conflicts or edits in progress. - -.m> todo - - ✅ - - No conflicts or edits in progress. - -``` diff --git a/unison-src/transcripts/fix2004.md b/unison-src/transcripts/fix2004.md deleted file mode 100644 index ab33da9e7f..0000000000 --- a/unison-src/transcripts/fix2004.md +++ /dev/null @@ -1,82 +0,0 @@ - -```ucm:hide -.> builtins.merge -``` - -Here's the scenario that can produce bad empty namespace LCAs: - -``` - deletes of v4 -j1: ... - v1 - v2 - v3 - v4 - v4a - v5 - v6 - v7 - / - - v5a - - adds of unrelated -j2: ... - v1 - v2 - v3 - v4 - x0 - x1 - x2 - x3 - / - - z1 - -``` - -So `j1` and `j2` have common history up through `v4`, then `j1` deletes some definitions while `j2` adds some definitions via shallow merges. These shallow merges then result in the LCA being the empty namespace rather than `v4`. - -First, we create some common history before a fork: - -```ucm -.> alias.term builtin.Nat.+ a.delete1 -.> alias.term builtin.Nat.* a.delete2 -.> alias.term builtin.Nat.drop a.delete3 -.> alias.type builtin.Nat a.Delete4 -``` - -Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previously and then adding one unrelated term via a merge with little history. It's this short history merge which will become a bad LCA of the empty namespace. - -```ucm -.> fork a a2 -.> delete.term.verbose a.delete1 -.> delete.term.verbose a.delete2 -.> delete.term.verbose a.delete3 -.> delete.type.verbose a.Delete4 -.> alias.term .builtin.Float.+ newbranchA.dontDelete -.> merge.old newbranchA a -.a> find -``` - -Meanwhile, `a2` adds some other unrelated terms, some via merging in namespaces with little history. When merging `a2` back into `a`, the deletes from their common history should be respected. - -```ucm -.> alias.term builtin.Text.take a2.keep1 -.> alias.term builtin.Text.take a2.keep2 -.> alias.term builtin.Text.take a2.keep3 -.> alias.term builtin.Text.take a2.keep4 -.> alias.term builtin.Text.take a2.keep5 -.> alias.term builtin.Text.take newbranchA2.keep6 -.> merge.old newbranchA2 a2 -.a2> find -``` - -```ucm -.> fork a asquash -.> merge.old a2 a -.> merge.old.squash a2 asquash -``` - -At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) should be deleted in both the merged and squashed results. Let's verify this: - -```ucm -.a> find -.asquash> find -``` - -```ucm:hide -.> view a.keep1 a.keep2 a.keep3 -.> view asquash.keep1 asquash.keep2 asquash.keep3 -``` - -```ucm:error -.> view a.Delete4 -``` - -```ucm:error -.> view asquash.delete1 -``` diff --git a/unison-src/transcripts/fix2004.output.md b/unison-src/transcripts/fix2004.output.md deleted file mode 100644 index c8216d5e89..0000000000 --- a/unison-src/transcripts/fix2004.output.md +++ /dev/null @@ -1,267 +0,0 @@ - -Here's the scenario that can produce bad empty namespace LCAs: - -```deletes -of v4 -j1: ... - v1 - v2 - v3 - v4 - v4a - v5 - v6 - v7 - / - - v5a - - adds of unrelated -j2: ... - v1 - v2 - v3 - v4 - x0 - x1 - x2 - x3 - / - - z1 - - -``` - -So `j1` and `j2` have common history up through `v4`, then `j1` deletes some definitions while `j2` adds some definitions via shallow merges. These shallow merges then result in the LCA being the empty namespace rather than `v4`. - -First, we create some common history before a fork: - -```ucm -.> alias.term builtin.Nat.+ a.delete1 - - Done. - -.> alias.term builtin.Nat.* a.delete2 - - Done. - -.> alias.term builtin.Nat.drop a.delete3 - - Done. - -.> alias.type builtin.Nat a.Delete4 - - Done. - -``` -Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previously and then adding one unrelated term via a merge with little history. It's this short history merge which will become a bad LCA of the empty namespace. - -```ucm -.> fork a a2 - - Done. - -.> delete.term.verbose a.delete1 - - Name changes: - - Original Changes - 1. a.delete1 ┐ 2. a.delete1 (removed) - 3. a2.delete1 │ - 4. builtin.Nat.+ ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> delete.term.verbose a.delete2 - - Name changes: - - Original Changes - 1. a.delete2 ┐ 2. a.delete2 (removed) - 3. a2.delete2 │ - 4. builtin.Nat.* ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> delete.term.verbose a.delete3 - - Name changes: - - Original Changes - 1. a.delete3 ┐ 2. a.delete3 (removed) - 3. a2.delete3 │ - 4. builtin.Nat.drop ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> delete.type.verbose a.Delete4 - - Name changes: - - Original Changes - 1. a.Delete4 ┐ 2. a.Delete4 (removed) - 3. a2.Delete4 │ - 4. builtin.Nat ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> alias.term .builtin.Float.+ newbranchA.dontDelete - - Done. - -.> merge.old newbranchA a - - Here's what's changed in a after the merge: - - Added definitions: - - 1. dontDelete : Float -> Float -> Float - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.a> find - - 1. dontDelete : ##Float -> ##Float -> ##Float - - -``` -Meanwhile, `a2` adds some other unrelated terms, some via merging in namespaces with little history. When merging `a2` back into `a`, the deletes from their common history should be respected. - -```ucm -.> alias.term builtin.Text.take a2.keep1 - - Done. - -.> alias.term builtin.Text.take a2.keep2 - - Done. - -.> alias.term builtin.Text.take a2.keep3 - - Done. - -.> alias.term builtin.Text.take a2.keep4 - - Done. - -.> alias.term builtin.Text.take a2.keep5 - - Done. - -.> alias.term builtin.Text.take newbranchA2.keep6 - - Done. - -.> merge.old newbranchA2 a2 - - Here's what's changed in a2 after the merge: - - Name changes: - - Original Changes - 1. keep1 ┐ 2. keep6 (added) - 3. keep2 │ - 4. keep3 │ - 5. keep4 │ - 6. keep5 ┘ - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.a2> find - - 1. delete1 : Delete4 -> Delete4 -> Delete4 - 2. delete2 : Delete4 -> Delete4 -> Delete4 - 3. delete3 : Delete4 -> Delete4 -> Delete4 - 4. builtin type Delete4 - 5. keep1 : Delete4 -> ##Text -> ##Text - 6. keep2 : Delete4 -> ##Text -> ##Text - 7. keep3 : Delete4 -> ##Text -> ##Text - 8. keep4 : Delete4 -> ##Text -> ##Text - 9. keep5 : Delete4 -> ##Text -> ##Text - 10. keep6 : Delete4 -> ##Text -> ##Text - - -``` -```ucm -.> fork a asquash - - Done. - -.> merge.old a2 a - - Here's what's changed in a after the merge: - - Added definitions: - - 1. ┌ keep1 : Delete4 -> Text -> Text - 2. │ keep2 : Delete4 -> Text -> Text - 3. │ keep3 : Delete4 -> Text -> Text - 4. │ keep4 : Delete4 -> Text -> Text - 5. │ keep5 : Delete4 -> Text -> Text - 6. └ keep6 : Delete4 -> Text -> Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash a2 asquash - - Here's what's changed in asquash after the merge: - - Added definitions: - - 1. ┌ keep1 : Delete4 -> Text -> Text - 2. │ keep2 : Delete4 -> Text -> Text - 3. │ keep3 : Delete4 -> Text -> Text - 4. │ keep4 : Delete4 -> Text -> Text - 5. │ keep5 : Delete4 -> Text -> Text - 6. └ keep6 : Delete4 -> Text -> Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) should be deleted in both the merged and squashed results. Let's verify this: - -```ucm -.a> find - - 1. dontDelete : ##Float -> ##Float -> ##Float - 2. keep1 : ##Nat -> ##Text -> ##Text - 3. keep2 : ##Nat -> ##Text -> ##Text - 4. keep3 : ##Nat -> ##Text -> ##Text - 5. keep4 : ##Nat -> ##Text -> ##Text - 6. keep5 : ##Nat -> ##Text -> ##Text - 7. keep6 : ##Nat -> ##Text -> ##Text - - -.asquash> find - - 1. dontDelete : ##Float -> ##Float -> ##Float - 2. keep1 : ##Nat -> ##Text -> ##Text - 3. keep2 : ##Nat -> ##Text -> ##Text - 4. keep3 : ##Nat -> ##Text -> ##Text - 5. keep4 : ##Nat -> ##Text -> ##Text - 6. keep5 : ##Nat -> ##Text -> ##Text - 7. keep6 : ##Nat -> ##Text -> ##Text - - -``` -```ucm -.> view a.Delete4 - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - a.Delete4 - -``` -```ucm -.> view asquash.delete1 - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - asquash.delete1 - -``` diff --git a/unison-src/transcripts/fix2026.md b/unison-src/transcripts/fix2026.md index 819a579e2f..df2a51f457 100644 --- a/unison-src/transcripts/fix2026.md +++ b/unison-src/transcripts/fix2026.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -40,5 +40,5 @@ Exception.unsafeRun! e _ = ``` ```ucm -.> run ex +scratch/main> run ex ``` \ No newline at end of file diff --git a/unison-src/transcripts/fix2026.output.md b/unison-src/transcripts/fix2026.output.md index 1391a35c6b..254fcb72c7 100644 --- a/unison-src/transcripts/fix2026.output.md +++ b/unison-src/transcripts/fix2026.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability Exception where raise : Failure -> x ex = unsafeRun! '(printLine "hello world") @@ -35,7 +35,7 @@ Exception.unsafeRun! e _ = handle !e with h ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -63,8 +63,8 @@ Exception.unsafeRun! e _ = toException : Either Failure a ->{Exception} a ``` -```ucm -.> run ex +``` ucm +scratch/main> run ex () diff --git a/unison-src/transcripts/fix2027.md b/unison-src/transcripts/fix2027.md index bcc0824566..2a386ae315 100644 --- a/unison-src/transcripts/fix2027.md +++ b/unison-src/transcripts/fix2027.md @@ -1,7 +1,7 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -51,5 +51,5 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0") ``` ```ucm:error -.> run myServer +scratch/main> run myServer ``` diff --git a/unison-src/transcripts/fix2027.output.md b/unison-src/transcripts/fix2027.output.md index b69a8b31bb..3d224d6446 100644 --- a/unison-src/transcripts/fix2027.output.md +++ b/unison-src/transcripts/fix2027.output.md @@ -1,6 +1,4 @@ - - -```unison +``` unison structural ability Exception where raise : Failure -> x reraise = cases @@ -46,7 +44,7 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0") ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -79,8 +77,8 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0") toException : Either Failure a ->{Exception} a ``` -```ucm -.> run myServer +``` ucm +scratch/main> run myServer 💔💥 diff --git a/unison-src/transcripts/fix2049.md b/unison-src/transcripts/fix2049.md index ab1983e95b..c0cfc4fdb2 100644 --- a/unison-src/transcripts/fix2049.md +++ b/unison-src/transcripts/fix2049.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -74,6 +74,6 @@ tests _ = ``` ```ucm -.> add -.> io.test tests +scratch/main> add +scratch/main> io.test tests ``` diff --git a/unison-src/transcripts/fix2049.output.md b/unison-src/transcripts/fix2049.output.md index 7e18e1f6c9..a9354446f8 100644 --- a/unison-src/transcripts/fix2049.output.md +++ b/unison-src/transcripts/fix2049.output.md @@ -1,4 +1,4 @@ -```unison +``` unison id x = x structural ability Stream a where @@ -48,7 +48,7 @@ Fold.Stream.fold = !res Universal.== false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -87,7 +87,7 @@ Fold.Stream.fold = ``` Tests some capabilities for catching runtime exceptions. -```unison +``` unison catcher : '{IO} () ->{IO} Result catcher act = handle tryEval act with cases @@ -106,7 +106,7 @@ tests _ = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -120,24 +120,24 @@ tests _ = tests : ∀ _. _ ->{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: catcher : '{IO} () ->{IO} Result tests : ∀ _. _ ->{IO} [Result] -.> io.test tests +scratch/main> io.test tests New test results: - ◉ tests caught - ◉ tests caught - ◉ tests got the right answer + 1. tests ◉ caught + ◉ caught + ◉ got the right answer ✅ 3 test(s) passing - Tip: Use view tests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/fix2053.md b/unison-src/transcripts/fix2053.md index 120bbed317..71f36094cb 100644 --- a/unison-src/transcripts/fix2053.md +++ b/unison-src/transcripts/fix2053.md @@ -1,7 +1,7 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```ucm -.> display List.map +scratch/main> display List.map ``` diff --git a/unison-src/transcripts/fix2053.output.md b/unison-src/transcripts/fix2053.output.md index d1cf4ec78e..ae97366dfb 100644 --- a/unison-src/transcripts/fix2053.output.md +++ b/unison-src/transcripts/fix2053.output.md @@ -1,5 +1,5 @@ -```ucm -.> display List.map +``` ucm +scratch/main> display List.map f a -> let diff --git a/unison-src/transcripts/fix2156.md b/unison-src/transcripts/fix2156.md index 2bc440b149..f18d03fd13 100644 --- a/unison-src/transcripts/fix2156.md +++ b/unison-src/transcripts/fix2156.md @@ -3,7 +3,7 @@ Tests for a case where bad eta reduction was causing erroneous watch output/caching. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2156.output.md b/unison-src/transcripts/fix2156.output.md index c4eed7557a..4a15b1accb 100644 --- a/unison-src/transcripts/fix2156.output.md +++ b/unison-src/transcripts/fix2156.output.md @@ -1,15 +1,14 @@ - Tests for a case where bad eta reduction was causing erroneous watch output/caching. -```unison +``` unison sqr : Nat -> Nat sqr n = n * n > sqr ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2167.md b/unison-src/transcripts/fix2167.md index 4e65ddb6f6..5d0381f70e 100644 --- a/unison-src/transcripts/fix2167.md +++ b/unison-src/transcripts/fix2167.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This is just a simple transcript to regression check an ability diff --git a/unison-src/transcripts/fix2167.output.md b/unison-src/transcripts/fix2167.output.md index 3d8c3251f6..d4e630f596 100644 --- a/unison-src/transcripts/fix2167.output.md +++ b/unison-src/transcripts/fix2167.output.md @@ -1,7 +1,7 @@ This is just a simple transcript to regression check an ability inference/checking issue. -```unison +``` unison structural ability R t where die : () -> x near.impl : Nat -> Either () [Nat] @@ -15,7 +15,7 @@ R.near1 region loc = match R.near 42 with ls -> R.die () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -37,3 +37,4 @@ fail because the type was invalid. The fix was to avoid dropping certain existential variables out of scope. + diff --git a/unison-src/transcripts/fix2187.md b/unison-src/transcripts/fix2187.md index f519c30de4..2d0eb3fe7a 100644 --- a/unison-src/transcripts/fix2187.md +++ b/unison-src/transcripts/fix2187.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2187.output.md b/unison-src/transcripts/fix2187.output.md index 8f499449e2..12a1aab7ff 100644 --- a/unison-src/transcripts/fix2187.output.md +++ b/unison-src/transcripts/fix2187.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lexicalScopeEx: [Text] lexicalScopeEx = parent = "outer" @@ -13,7 +13,7 @@ lexicalScopeEx = ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2231.md b/unison-src/transcripts/fix2231.md index 0b1ed16419..2fe2660b13 100644 --- a/unison-src/transcripts/fix2231.md +++ b/unison-src/transcripts/fix2231.md @@ -7,7 +7,7 @@ the choices may not work equally well with the type checking strategies. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -25,5 +25,5 @@ txt = foldl (Text.++) "" ["a", "b", "c"] ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/fix2231.output.md b/unison-src/transcripts/fix2231.output.md index 2ff24e5bcf..d0e410477d 100644 --- a/unison-src/transcripts/fix2231.output.md +++ b/unison-src/transcripts/fix2231.output.md @@ -6,7 +6,7 @@ and while they are all valid and some may be equivalently general, the choices may not work equally well with the type checking strategies. -```unison +``` unison (<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c (<<) f g x = f (g x) @@ -20,7 +20,7 @@ foldl f a = cases txt = foldl (Text.++) "" ["a", "b", "c"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,8 +36,8 @@ txt = foldl (Text.++) "" ["a", "b", "c"] txt : Text ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2238.md b/unison-src/transcripts/fix2238.md index 3562096397..37a948c0f0 100644 --- a/unison-src/transcripts/fix2238.md +++ b/unison-src/transcripts/fix2238.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` This should not typecheck - the inline `@eval` expression uses abilities. @@ -14,5 +14,5 @@ ex = {{ @eval{abort} }} This file should also not typecheck - it has a triple backticks block that uses abilities. ```ucm:error -.> load unison-src/transcripts/fix2238.u +scratch/main> load unison-src/transcripts/fix2238.u ``` diff --git a/unison-src/transcripts/fix2238.output.md b/unison-src/transcripts/fix2238.output.md index 31a4aca9f0..0958d7182d 100644 --- a/unison-src/transcripts/fix2238.output.md +++ b/unison-src/transcripts/fix2238.output.md @@ -1,13 +1,12 @@ - This should not typecheck - the inline `@eval` expression uses abilities. -```unison +``` unison structural ability Abort where abort : x ex = {{ @eval{abort} }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,8 +18,8 @@ ex = {{ @eval{abort} }} ``` This file should also not typecheck - it has a triple backticks block that uses abilities. -```ucm -.> load unison-src/transcripts/fix2238.u +``` ucm +scratch/main> load unison-src/transcripts/fix2238.u Loading changes detected in unison-src/transcripts/fix2238.u. diff --git a/unison-src/transcripts/fix2244.md b/unison-src/transcripts/fix2244.md index e270dc5f27..e1dba0b05e 100644 --- a/unison-src/transcripts/fix2244.md +++ b/unison-src/transcripts/fix2244.md @@ -1,13 +1,13 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` Ensure closing token is emitted by closing brace in doc eval block. ```ucm -.> load ./unison-src/transcripts/fix2244.u +scratch/main> load ./unison-src/transcripts/fix2244.u ``` ```ucm:hide -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/fix2244.output.md b/unison-src/transcripts/fix2244.output.md index 44b65347d9..2341d1a265 100644 --- a/unison-src/transcripts/fix2244.output.md +++ b/unison-src/transcripts/fix2244.output.md @@ -1,7 +1,7 @@ Ensure closing token is emitted by closing brace in doc eval block. -```ucm -.> load ./unison-src/transcripts/fix2244.u +``` ucm +scratch/main> load ./unison-src/transcripts/fix2244.u Loading changes detected in ./unison-src/transcripts/fix2244.u. diff --git a/unison-src/transcripts/fix2254.md b/unison-src/transcripts/fix2254.md index 3b6dd15e6c..36ed00e6b0 100644 --- a/unison-src/transcripts/fix2254.md +++ b/unison-src/transcripts/fix2254.md @@ -1,6 +1,6 @@ ```ucm:hide -.a> builtins.merge +scratch/a> builtins.merge lib.builtins ``` This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: @@ -35,11 +35,12 @@ g = cases _ -> 43 ``` -We'll make our edits in a fork of the `a` namespace: +We'll make our edits in a new branch. ```ucm -.a> add -.> fork a a2 +scratch/a> add +scratch/a> branch /a2 +scratch/a2> ``` First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. @@ -56,31 +57,29 @@ unique type A a b c d Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: ```ucm -.a2> update.old -.a2> view A NeedsA f f2 f3 g -.a2> todo -``` - -```ucm:hide -.a2> builtins.merge +scratch/a2> update +scratch/a2> view A NeedsA f f2 f3 g +scratch/a2> todo ``` ## Record updates Here's a test of updating a record: +```ucm:hide +scratch/r1> builtins.merge lib.builtins +``` + + ```unison structural type Rec = { uno : Nat, dos : Nat } combine r = uno r + dos r ``` -```ucm:hide -.a3> builtins.merge -``` - ```ucm -.a3> add +scratch/r1> add +scratch/r1> branch r2 ``` ```unison @@ -90,7 +89,6 @@ structural type Rec = { uno : Nat, dos : Nat, tres : Text } And checking that after updating this record, there's nothing `todo`: ```ucm -.> fork a3 a4 -.a4> update.old -.a4> todo +scratch/r2> update +scratch/r2> todo ``` diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index 61af269b2c..05a1009e49 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -1,7 +1,6 @@ - This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: -```unison +``` unison unique type A a b c d = A a | B b @@ -31,10 +30,10 @@ g = cases _ -> 43 ``` -We'll make our edits in a fork of the `a` namespace: +We'll make our edits in a new branch. -```ucm -.a> add +``` ucm +scratch/a> add ⍟ I've added these definitions: @@ -45,14 +44,17 @@ We'll make our edits in a fork of the `a` namespace: f3 : NeedsA Nat Nat -> Nat g : A Nat Nat Nat Nat -> Nat -.> fork a a2 +scratch/a> branch /a2 - Done. + Done. I've created the a2 branch based off of a. + + Tip: To merge your work back into the a branch, first + `switch /a` then `merge /a2`. ``` First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. -```unison +``` unison unique type A a b c d = A a | B b @@ -63,25 +65,30 @@ unique type A a b c d Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: -```ucm -.a2> update.old +``` ucm +scratch/a2> update - ⍟ I've updated these names to your new definition: - - type A a b c d + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... -.a2> view A NeedsA f f2 f3 g + Done. + +scratch/a2> view A NeedsA f f2 f3 g type A a b c d - = B b + = A a | D d | E a d + | B b | C c - | A a structural type NeedsA a b - = Zoink Text - | NeedsA (A a b Nat Nat) + = NeedsA (A a b Nat Nat) + | Zoink Text f : A Nat Nat Nat Nat -> Nat f = cases @@ -104,24 +111,22 @@ Let's do the update now, and verify that the definitions all look good and there D n -> n _ -> 43 -.a2> todo +scratch/a2> todo - ✅ - - No conflicts or edits in progress. + You have no pending todo items. Good work! ✅ ``` ## Record updates Here's a test of updating a record: -```unison +``` unison structural type Rec = { uno : Nat, dos : Nat } combine r = uno r + dos r ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -141,8 +146,8 @@ combine r = uno r + dos r combine : Rec -> Nat ``` -```ucm -.a3> add +``` ucm +scratch/r1> add ⍟ I've added these definitions: @@ -155,12 +160,19 @@ combine r = uno r + dos r Rec.uno.set : Nat -> Rec -> Rec combine : Rec -> Nat +scratch/r1> branch r2 + + Done. I've created the r2 branch based off of r1. + + Tip: To merge your work back into the r1 branch, first + `switch /r1` then `merge /r2`. + ``` -```unison +``` unison structural type Rec = { uno : Nat, dos : Nat, tres : Text } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -188,33 +200,20 @@ structural type Rec = { uno : Nat, dos : Nat, tres : Text } ``` And checking that after updating this record, there's nothing `todo`: -```ucm -.> fork a3 a4 +``` ucm +scratch/r2> update - Done. + Okay, I'm searching the branch for code that needs to be + updated... -.a4> update.old + That's done. Now I'm making sure everything typechecks... - ⍟ I've added these definitions: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ I've updated these names to your new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec + Everything typechecks, so I'm saving the results... -.a4> todo + Done. - ✅ - - No conflicts or edits in progress. +scratch/r2> todo + + You have no pending todo items. Good work! ✅ ``` diff --git a/unison-src/transcripts/fix2268.md b/unison-src/transcripts/fix2268.md index 504e2da734..0892d924e7 100644 --- a/unison-src/transcripts/fix2268.md +++ b/unison-src/transcripts/fix2268.md @@ -3,7 +3,7 @@ inferred types that didn't contain arrows, so effects that just yield a value weren't getting disambiguated. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2268.output.md b/unison-src/transcripts/fix2268.output.md index bfb65920fd..79da655962 100644 --- a/unison-src/transcripts/fix2268.output.md +++ b/unison-src/transcripts/fix2268.output.md @@ -2,7 +2,7 @@ Tests for a TDNR case that wasn't working. The code wasn't 'relaxing' inferred types that didn't contain arrows, so effects that just yield a value weren't getting disambiguated. -```unison +``` unison unique ability A where a : Nat @@ -15,7 +15,7 @@ test _ = toNat x ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2334.md b/unison-src/transcripts/fix2334.md index 0bc9a2d7d3..9044000b5e 100644 --- a/unison-src/transcripts/fix2334.md +++ b/unison-src/transcripts/fix2334.md @@ -3,7 +3,7 @@ Tests an issue where pattern matching matrices involving built-in types was discarding default cases in some branches. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2334.output.md b/unison-src/transcripts/fix2334.output.md index 669017cd88..ab20adb8e7 100644 --- a/unison-src/transcripts/fix2334.output.md +++ b/unison-src/transcripts/fix2334.output.md @@ -1,8 +1,7 @@ - Tests an issue where pattern matching matrices involving built-in types was discarding default cases in some branches. -```unison +``` unison f = cases 0, 0 -> 0 _, 1 -> 2 @@ -15,7 +14,7 @@ f = cases > f 1 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2344.md b/unison-src/transcripts/fix2344.md index 6dd1e0ca21..2593c2f18e 100644 --- a/unison-src/transcripts/fix2344.md +++ b/unison-src/transcripts/fix2344.md @@ -5,7 +5,7 @@ The binds were causing some sequences of lets to be unnecessarily recursive. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2344.output.md b/unison-src/transcripts/fix2344.output.md index 6d0ae41c4f..1d57076149 100644 --- a/unison-src/transcripts/fix2344.output.md +++ b/unison-src/transcripts/fix2344.output.md @@ -1,10 +1,9 @@ - Checks a corner case with type checking involving destructuring binds. The binds were causing some sequences of lets to be unnecessarily recursive. -```unison +``` unison unique ability Nate where nate: (Boolean, Nat) antiNate: () @@ -17,7 +16,7 @@ sneezy dee _ = dee 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2350.output.md b/unison-src/transcripts/fix2350.output.md index d8f6bf43b1..cb0cf5de75 100644 --- a/unison-src/transcripts/fix2350.output.md +++ b/unison-src/transcripts/fix2350.output.md @@ -1,9 +1,10 @@ - This tests an issue where ability variables were being defaulted over eagerly. In general, we want to avoid collecting up variables from the use of definitions with types like: - T ->{e} U +``` +T ->{e} U +``` Since this type works for every `e`, it is, 'pure;' and we might as well have `e = {}`, since `{}` is a subrow of every other row. @@ -12,12 +13,14 @@ ongoing inference, it's undesirable to default it. Previously there was a check to see if `e` occurred in the context. However, the wanted abilities being collected aren't in the context, so types like: - T ->{S e} U ->{e} V +``` +T ->{S e} U ->{e} V +``` were a corner case. We would add `S e` to the wanted abilities, then not realize that `e` shouldn't be defaulted. -```unison +``` unison unique ability Storage d g where save.impl : a ->{Storage d g} ('{g} (d a)) @@ -25,7 +28,7 @@ save : a ->{Storage d g, g} (d a) save a = !(save.impl a) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2353.md b/unison-src/transcripts/fix2353.md index 50d0827a6d..f9662633cd 100644 --- a/unison-src/transcripts/fix2353.md +++ b/unison-src/transcripts/fix2353.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2353.output.md b/unison-src/transcripts/fix2353.output.md index 74c9da016f..a6a8be6b6c 100644 --- a/unison-src/transcripts/fix2353.output.md +++ b/unison-src/transcripts/fix2353.output.md @@ -1,4 +1,4 @@ -```unison +``` unison use builtin Scope unique ability Async t g where async : {g} Nat unique ability Exception where raise : Nat -> x @@ -11,7 +11,7 @@ pure.run a0 a = Scope.run a' ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2354.md b/unison-src/transcripts/fix2354.md index 7346e368cf..f8a637022d 100644 --- a/unison-src/transcripts/fix2354.md +++ b/unison-src/transcripts/fix2354.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests that delaying an un-annotated higher-rank type gives a normal diff --git a/unison-src/transcripts/fix2354.output.md b/unison-src/transcripts/fix2354.output.md index 7fcfce26a9..226d20bc54 100644 --- a/unison-src/transcripts/fix2354.output.md +++ b/unison-src/transcripts/fix2354.output.md @@ -1,15 +1,14 @@ - Tests that delaying an un-annotated higher-rank type gives a normal type error, rather than an internal compiler error. -```unison +``` unison f : (forall a . a -> a) -> Nat f id = id 0 x = 'f ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2355.md b/unison-src/transcripts/fix2355.md index 25f4840b31..a9b22fc3f3 100644 --- a/unison-src/transcripts/fix2355.md +++ b/unison-src/transcripts/fix2355.md @@ -2,7 +2,7 @@ Tests for a loop that was previously occurring in the type checker. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:error diff --git a/unison-src/transcripts/fix2355.output.md b/unison-src/transcripts/fix2355.output.md index ce2f06798e..b162860a9f 100644 --- a/unison-src/transcripts/fix2355.output.md +++ b/unison-src/transcripts/fix2355.output.md @@ -1,7 +1,6 @@ - Tests for a loop that was previously occurring in the type checker. -```unison +``` unison structural ability A t g where fork : '{g, A t g} a -> t a await : t a -> a @@ -20,7 +19,7 @@ example = 'let A.await r ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,7 +27,7 @@ example = 'let The expression in red was inferred to require the ability: - {A t25 {𝕖39, 𝕖18}} + {A t25 {𝕖36, 𝕖18}} where `𝕖18` is its overall abilities. diff --git a/unison-src/transcripts/fix2378.md b/unison-src/transcripts/fix2378.md index d4358c26e9..586e6335c3 100644 --- a/unison-src/transcripts/fix2378.md +++ b/unison-src/transcripts/fix2378.md @@ -4,7 +4,7 @@ checking wanted vs. provided abilities. It was necessary to re-check rows until a fixed point is reached. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2378.output.md b/unison-src/transcripts/fix2378.output.md index 5acef2316d..0c63239cc5 100644 --- a/unison-src/transcripts/fix2378.output.md +++ b/unison-src/transcripts/fix2378.output.md @@ -1,9 +1,8 @@ - Tests for an ability failure that was caused by order dependence of checking wanted vs. provided abilities. It was necessary to re-check rows until a fixed point is reached. -```unison +``` unison unique ability C c where new : c a receive : c a -> a @@ -39,7 +38,7 @@ x : '{} (Either () Nat) x _ = Ex.catch '(C.pure.run '(A.pure.run ex)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2423.md b/unison-src/transcripts/fix2423.md index 4f5d073c0a..72b3450557 100644 --- a/unison-src/transcripts/fix2423.md +++ b/unison-src/transcripts/fix2423.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2423.output.md b/unison-src/transcripts/fix2423.output.md index 6deb34d734..40d2fa6509 100644 --- a/unison-src/transcripts/fix2423.output.md +++ b/unison-src/transcripts/fix2423.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability Split where skip! : x both : a -> a -> a @@ -26,7 +26,7 @@ Split.zipSame sa sb _ = handle !sa with go sb ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2474.md b/unison-src/transcripts/fix2474.md index a718719bd9..e84cd4a9e7 100644 --- a/unison-src/transcripts/fix2474.md +++ b/unison-src/transcripts/fix2474.md @@ -1,9 +1,8 @@ - Tests an issue with a lack of generality of handlers. In general, a set of cases: - { e ... -> k } + { e ... -> k } should be typed in the following way: @@ -18,7 +17,7 @@ should be typed in the following way: the ability that contains `e`. ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2474.output.md b/unison-src/transcripts/fix2474.output.md index 7f6472f094..519f0d2b30 100644 --- a/unison-src/transcripts/fix2474.output.md +++ b/unison-src/transcripts/fix2474.output.md @@ -1,29 +1,30 @@ - Tests an issue with a lack of generality of handlers. In general, a set of cases: - { e ... -> k } +``` +{ e ... -> k } +``` should be typed in the following way: - 1. The scrutinee has type `Request {E, g} r -> s` where `E` is all - the abilities being handled. `g` is a slack variable, because all - abilities that are used in the handled expression pass through - the handler. Previously this was being inferred as merely - `Request {E} r -> s` - 2. The continuation variable `k` should have type `o ->{E, g} r`, - matching the above types (`o` is the result type of `e`). - Previously this was being checked as `o ->{E0} r`, where `E0` is - the ability that contains `e`. +1. The scrutinee has type `Request {E, g} r -> s` where `E` is all + the abilities being handled. `g` is a slack variable, because all + abilities that are used in the handled expression pass through + the handler. Previously this was being inferred as merely + `Request {E} r -> s` +2. The continuation variable `k` should have type `o ->{E, g} r`, + matching the above types (`o` is the result type of `e`). + Previously this was being checked as `o ->{E0} r`, where `E0` is + the ability that contains `e`. -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison structural ability Stream a where emit : a -> () @@ -36,7 +37,7 @@ Stream.uncons s = handle !s with go ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2628.md b/unison-src/transcripts/fix2628.md index 5c3ec8df50..cef5bd4a98 100644 --- a/unison-src/transcripts/fix2628.md +++ b/unison-src/transcripts/fix2628.md @@ -1,5 +1,5 @@ ```ucm:hide -.> alias.type ##Nat .base.Nat +scratch/main> alias.type ##Nat lib.base.Nat ``` ```unison:hide @@ -9,7 +9,7 @@ unique type foo.bar.baz.MyRecord = { ``` ```ucm -.> add +scratch/main> add -.> find : Nat -> MyRecord +scratch/main> find : Nat -> MyRecord ``` diff --git a/unison-src/transcripts/fix2628.output.md b/unison-src/transcripts/fix2628.output.md index 64b45ed29b..87aa68a672 100644 --- a/unison-src/transcripts/fix2628.output.md +++ b/unison-src/transcripts/fix2628.output.md @@ -1,11 +1,11 @@ -```unison +``` unison unique type foo.bar.baz.MyRecord = { value : Nat } ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -18,7 +18,7 @@ unique type foo.bar.baz.MyRecord = { -> MyRecord -> MyRecord -.> find : Nat -> MyRecord +scratch/main> find : Nat -> MyRecord 1. foo.bar.baz.MyRecord.MyRecord : Nat -> MyRecord diff --git a/unison-src/transcripts/fix2663.md b/unison-src/transcripts/fix2663.md index 6d2ccd7242..ee6a5b749a 100644 --- a/unison-src/transcripts/fix2663.md +++ b/unison-src/transcripts/fix2663.md @@ -1,14 +1,13 @@ - Tests a variable capture problem. After pattern compilation, the match would end up: - T p1 p3 p3 + T p1 p3 p3 and z would end up referring to the first p3 rather than the second. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2663.output.md b/unison-src/transcripts/fix2663.output.md index c250fb403e..2e12426d9b 100644 --- a/unison-src/transcripts/fix2663.output.md +++ b/unison-src/transcripts/fix2663.output.md @@ -1,13 +1,14 @@ - Tests a variable capture problem. After pattern compilation, the match would end up: - T p1 p3 p3 +``` +T p1 p3 p3 +``` and z would end up referring to the first p3 rather than the second. -```unison +``` unison structural type Trip = T Nat Nat Nat bad : Nat -> (Nat, Nat) @@ -19,7 +20,7 @@ bad x = match Some (Some x) with > bad 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2693.md b/unison-src/transcripts/fix2693.md index 947e35b701..2bd2a0082e 100644 --- a/unison-src/transcripts/fix2693.md +++ b/unison-src/transcripts/fix2693.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -14,7 +14,7 @@ range = loop [] ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/fix2693.output.md b/unison-src/transcripts/fix2693.output.md index 22a46bec21..e5414c32a8 100644 --- a/unison-src/transcripts/fix2693.output.md +++ b/unison-src/transcripts/fix2693.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison loop : List Nat -> Nat -> List Nat loop l = cases 0 -> l @@ -9,7 +8,7 @@ range : Nat -> List Nat range = loop [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,8 +22,8 @@ range = loop [] range : Nat -> [Nat] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -32,11 +31,11 @@ range = loop [] range : Nat -> [Nat] ``` -```unison +``` unison > range 2000 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2054,11 +2053,11 @@ range = loop [] ``` Should be cached: -```unison +``` unison > range 2000 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2712.md b/unison-src/transcripts/fix2712.md index fce7511665..4483f00bd1 100644 --- a/unison-src/transcripts/fix2712.md +++ b/unison-src/transcripts/fix2712.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,7 +10,7 @@ mapWithKey f m = Tip ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/fix2712.output.md b/unison-src/transcripts/fix2712.output.md index 08cdb89a30..4181235105 100644 --- a/unison-src/transcripts/fix2712.output.md +++ b/unison-src/transcripts/fix2712.output.md @@ -1,11 +1,11 @@ -```unison +``` unison unique type Map k v = Tip | Bin Nat k v (Map k v) (Map k v) mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b mapWithKey f m = Tip ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,8 +19,8 @@ mapWithKey f m = Tip mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -28,7 +28,7 @@ mapWithKey f m = Tip mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b ``` -```unison +``` unison naiomi = susan: Nat -> Nat -> () susan a b = () @@ -40,7 +40,7 @@ naiomi = ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2795.md b/unison-src/transcripts/fix2795.md index d4b61c99b3..1e2ca1764d 100644 --- a/unison-src/transcripts/fix2795.md +++ b/unison-src/transcripts/fix2795.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.mergeio -.> load unison-src/transcripts/fix2795/docs.u -.> display test +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts/fix2795/docs.u +scratch/main> display test ``` diff --git a/unison-src/transcripts/fix2795.output.md b/unison-src/transcripts/fix2795.output.md index 13a789f037..39da527ba0 100644 --- a/unison-src/transcripts/fix2795.output.md +++ b/unison-src/transcripts/fix2795.output.md @@ -1,9 +1,9 @@ -```ucm -.> builtins.mergeio +``` ucm +scratch/main> builtins.mergeio Done. -.> load unison-src/transcripts/fix2795/docs.u +scratch/main> load unison-src/transcripts/fix2795/docs.u Loading changes detected in unison-src/transcripts/fix2795/docs.u. @@ -17,7 +17,7 @@ t1 : Text test : Doc2 -.> display test +scratch/main> display test t : Text t = "hi" diff --git a/unison-src/transcripts/fix2826.md b/unison-src/transcripts/fix2826.md new file mode 100644 index 0000000000..d2ad94cd51 --- /dev/null +++ b/unison-src/transcripts/fix2826.md @@ -0,0 +1,23 @@ +```ucm +scratch/main> builtins.mergeio +``` + +Supports fences that are longer than three backticks. + +````unison + +doc = {{ + @typecheck ``` + x = 3 + ``` +}} + +```` + +And round-trips properly. + +```ucm +scratch/main> add +scratch/main> edit doc +scratch/main> load scratch.u +``` diff --git a/unison-src/transcripts/fix2826.output.md b/unison-src/transcripts/fix2826.output.md new file mode 100644 index 0000000000..cf691c1b62 --- /dev/null +++ b/unison-src/transcripts/fix2826.output.md @@ -0,0 +1,66 @@ +``` ucm +scratch/main> builtins.mergeio + + Done. + +``` +Supports fences that are longer than three backticks. + +```` unison +doc = {{ + @typecheck ``` + x = 3 + ``` +}} + +```` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + doc : Doc2 + +``` +And round-trips properly. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + doc : Doc2 + +scratch/main> edit doc + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load scratch.u + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +```` unison:added-by-ucm scratch.u +doc : Doc2 +doc = + {{ + @typecheck ``` + x = 3 + ``` + }} +```` + diff --git a/unison-src/transcripts/fix2840.md b/unison-src/transcripts/fix2840.md index be481b5bbd..518f90c45e 100644 --- a/unison-src/transcripts/fix2840.md +++ b/unison-src/transcripts/fix2840.md @@ -1,7 +1,7 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to be present in the active codebase when the `display` command was used render `Doc` values. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` First, a few \[hidden] definitions necessary for typechecking a simple Doc2. @@ -63,7 +63,7 @@ syntax.docWord = Word ``` ```ucm -.> add +scratch/main> add ``` Next, define and display a simple Doc: @@ -74,7 +74,7 @@ Hi ``` ```ucm -.> display README +scratch/main> display README ``` Previously, the error was: diff --git a/unison-src/transcripts/fix2840.output.md b/unison-src/transcripts/fix2840.output.md index c47df9a2c7..020c4b1a4d 100644 --- a/unison-src/transcripts/fix2840.output.md +++ b/unison-src/transcripts/fix2840.output.md @@ -1,9 +1,9 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to be present in the active codebase when the `display` command was used render `Doc` values. -First, a few \[hidden] definitions necessary for typechecking a simple Doc2. +First, a few \[hidden\] definitions necessary for typechecking a simple Doc2. -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -18,24 +18,25 @@ First, a few \[hidden] definitions necessary for typechecking a simple Doc2. ``` Next, define and display a simple Doc: -```unison + +``` unison README = {{ Hi }} ``` -```ucm -.> display README +``` ucm +scratch/main> display README Hi ``` Previously, the error was: -``` +``` ⚙️ Processing stanza 5 of 7.ucm: PE [("die",SrcLoc {srcLocPackage = "unison-parser-typechecker-0.0.0-He2Hp1llokT2nN4MnUfUXz", srcLocModule = "Unison.Runtime.Interface", srcLocFile = "src/Unison/Runtime/Interface.hs", srcLocStartLine = 118, srcLocStartCol = 18, srcLocEndLine = 118, srcLocEndCol = 60})] Lit AnnotatedText (fromList [Segment {segment = "Unknown term reference: #4522d", annotation = Nothing}]) - ``` but as of this PR, it's okay. + diff --git a/unison-src/transcripts/fix2970.md b/unison-src/transcripts/fix2970.md index d9a6a6b532..efcd59f181 100644 --- a/unison-src/transcripts/fix2970.md +++ b/unison-src/transcripts/fix2970.md @@ -1,7 +1,7 @@ Also fixes #1519 (it's the same issue). ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2970.output.md b/unison-src/transcripts/fix2970.output.md index 904508e2cd..7f5bddca1b 100644 --- a/unison-src/transcripts/fix2970.output.md +++ b/unison-src/transcripts/fix2970.output.md @@ -1,17 +1,17 @@ -Also fixes #1519 (it's the same issue). +Also fixes \#1519 (it's the same issue). -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison foo.+.doc : Nat foo.+.doc = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3037.md b/unison-src/transcripts/fix3037.md index c16c1f284f..af8fed9816 100644 --- a/unison-src/transcripts/fix3037.md +++ b/unison-src/transcripts/fix3037.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests for an unsound case of ability checking that was erroneously being diff --git a/unison-src/transcripts/fix3037.output.md b/unison-src/transcripts/fix3037.output.md index 1ffd18c3bc..aebd61c502 100644 --- a/unison-src/transcripts/fix3037.output.md +++ b/unison-src/transcripts/fix3037.output.md @@ -2,7 +2,7 @@ Tests for an unsound case of ability checking that was erroneously being accepted before. In certain cases, abilities were able to be added to rows in invariant positions. -```unison +``` unison structural type Runner g = Runner (forall a. '{g} a -> {} a) pureRunner : Runner {} @@ -13,7 +13,7 @@ runner : Runner {IO} runner = pureRunner ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -35,7 +35,7 @@ runner = pureRunner ``` Application version: -```unison +``` unison structural type A g = A (forall a. '{g} a ->{} a) anA : A {} @@ -47,7 +47,7 @@ h _ = () > h anA ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3171.md b/unison-src/transcripts/fix3171.md index 62790dd1aa..ad166c7f5e 100644 --- a/unison-src/transcripts/fix3171.md +++ b/unison-src/transcripts/fix3171.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests an case where decompiling could cause function arguments to occur in the diff --git a/unison-src/transcripts/fix3171.output.md b/unison-src/transcripts/fix3171.output.md index 6a6ba04962..8778f0442e 100644 --- a/unison-src/transcripts/fix3171.output.md +++ b/unison-src/transcripts/fix3171.output.md @@ -1,7 +1,7 @@ Tests an case where decompiling could cause function arguments to occur in the opposite order for partially applied functions. -```unison +``` unison f : Nat -> Nat -> Nat -> () -> Nat f x y z _ = x + y * z @@ -9,7 +9,7 @@ f x y z _ = x + y * z > f 1 2 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3196.md b/unison-src/transcripts/fix3196.md index d04592aa6c..46755570e5 100644 --- a/unison-src/transcripts/fix3196.md +++ b/unison-src/transcripts/fix3196.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests ability checking in scenarios where one side is concrete and the other is diff --git a/unison-src/transcripts/fix3196.output.md b/unison-src/transcripts/fix3196.output.md index 3a5e2944d1..3b8f046472 100644 --- a/unison-src/transcripts/fix3196.output.md +++ b/unison-src/transcripts/fix3196.output.md @@ -1,11 +1,10 @@ - Tests ability checking in scenarios where one side is concrete and the other is a variable. This was supposed to be covered, but the method wasn't actually symmetric, so doing `equate l r` might work, but not `equate r l`. Below were cases that caused the failing order. -```unison +``` unison structural type W es = W unique ability Zoot where @@ -27,7 +26,7 @@ w2 = cases W -> W > w2 w1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3215.md b/unison-src/transcripts/fix3215.md index af0e67e868..a0d1715a14 100644 --- a/unison-src/transcripts/fix3215.md +++ b/unison-src/transcripts/fix3215.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests a case where concrete abilities were appearing multiple times in an diff --git a/unison-src/transcripts/fix3215.output.md b/unison-src/transcripts/fix3215.output.md index aaa3e8f4c3..2f5128ffbc 100644 --- a/unison-src/transcripts/fix3215.output.md +++ b/unison-src/transcripts/fix3215.output.md @@ -3,7 +3,7 @@ inferred type. This was due to the pre-pass that figures out which abilities are being matched on. It was just concatenating the ability for each pattern into a list, and not checking whether there were duplicates. -```unison +``` unison structural ability T where nat : Nat int : Int @@ -16,7 +16,7 @@ f = cases {x} -> 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3244.md b/unison-src/transcripts/fix3244.md index 0ae745e897..e07581e2e2 100644 --- a/unison-src/transcripts/fix3244.md +++ b/unison-src/transcripts/fix3244.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This tests an previously erroneous case in the pattern compiler. It was assuming diff --git a/unison-src/transcripts/fix3244.output.md b/unison-src/transcripts/fix3244.output.md index 94231d1745..00899d4c5a 100644 --- a/unison-src/transcripts/fix3244.output.md +++ b/unison-src/transcripts/fix3244.output.md @@ -2,7 +2,7 @@ This tests an previously erroneous case in the pattern compiler. It was assuming that the variables bound in a guard matched the variables bound in the rest of the branch exactly, but apparently this needn't be the case. -```unison +``` unison foo t = (x, _) = t f w = w + x @@ -15,7 +15,7 @@ foo t = > foo (10,20) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3265.md b/unison-src/transcripts/fix3265.md index fcf9ce8fb9..5b06551112 100644 --- a/unison-src/transcripts/fix3265.md +++ b/unison-src/transcripts/fix3265.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests cases that produced bad decompilation output previously. There diff --git a/unison-src/transcripts/fix3265.output.md b/unison-src/transcripts/fix3265.output.md index 93e8db747f..1f70863dc7 100644 --- a/unison-src/transcripts/fix3265.output.md +++ b/unison-src/transcripts/fix3265.output.md @@ -1,12 +1,13 @@ Tests cases that produced bad decompilation output previously. There are three cases that need to be 'fixed up.' - 1. lambda expressions with free variables need to be beta reduced - 2. let defined functions need to have arguments removed and - occurrences rewritten. - 3. let-rec defined functions need to have arguments removed, but - it is a more complicated process. -```unison +1. lambda expressions with free variables need to be beta reduced +2. let defined functions need to have arguments removed and + occurrences rewritten. +3. let-rec defined functions need to have arguments removed, but + it is a more complicated process. + +``` unison > Any (w x -> let f0 y = match y with 0 -> x @@ -20,7 +21,7 @@ are three cases that need to be 'fixed up.' g (z -> x + f0 z)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +57,7 @@ always occur with `x` as the first argument, but if we aren't careful, we might do that, because we find the first occurrence of `f`, and discard its arguments, where `f` also occurs. -```unison +``` unison > Any (x -> let f x y = match y with 0 -> 0 @@ -65,7 +66,7 @@ discard its arguments, where `f` also occurs. f x 20) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3634.md b/unison-src/transcripts/fix3634.md index 0cb5f88dd9..fd1654739a 100644 --- a/unison-src/transcripts/fix3634.md +++ b/unison-src/transcripts/fix3634.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` @@ -16,6 +16,6 @@ d = {{ ``` ```ucm -.> add -.> display d +scratch/main> add +scratch/main> display d ``` \ No newline at end of file diff --git a/unison-src/transcripts/fix3634.output.md b/unison-src/transcripts/fix3634.output.md index 46f009f8cd..ac92ec60c2 100644 --- a/unison-src/transcripts/fix3634.output.md +++ b/unison-src/transcripts/fix3634.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type M a = N | J a d = {{ @@ -10,7 +10,7 @@ d = {{ }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,8 +25,8 @@ d = {{ d : Doc2 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -34,7 +34,7 @@ d = {{ (also named builtin.Optional) d : Doc2 -.> display d +scratch/main> display d `x -> J x` diff --git a/unison-src/transcripts/fix3678.md b/unison-src/transcripts/fix3678.md index 13bed5d26c..59ecfe787e 100644 --- a/unison-src/transcripts/fix3678.md +++ b/unison-src/transcripts/fix3678.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Array comparison was indexing out of bounds. diff --git a/unison-src/transcripts/fix3678.output.md b/unison-src/transcripts/fix3678.output.md index f99633e649..321c493f21 100644 --- a/unison-src/transcripts/fix3678.output.md +++ b/unison-src/transcripts/fix3678.output.md @@ -1,7 +1,6 @@ - Array comparison was indexing out of bounds. -```unison +``` unison arr = Scope.run do ma = Scope.arrayOf "asdf" 0 freeze! ma @@ -9,7 +8,7 @@ arr = Scope.run do > compare arr arr ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3752.md b/unison-src/transcripts/fix3752.md index 72979087f5..90fc207437 100644 --- a/unison-src/transcripts/fix3752.md +++ b/unison-src/transcripts/fix3752.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` These were failing to type check before, because id was not diff --git a/unison-src/transcripts/fix3752.output.md b/unison-src/transcripts/fix3752.output.md index fd477070ba..b22b33408e 100644 --- a/unison-src/transcripts/fix3752.output.md +++ b/unison-src/transcripts/fix3752.output.md @@ -1,7 +1,7 @@ These were failing to type check before, because id was not generalized. -```unison +``` unison foo = do id x = _ = 1 @@ -15,7 +15,7 @@ bar = do id "hello" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3759.md b/unison-src/transcripts/fix3759.md index 63047bc914..212bae6659 100644 --- a/unison-src/transcripts/fix3759.md +++ b/unison-src/transcripts/fix3759.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -14,7 +14,7 @@ Woot.frobnicate = 43 ``` ```ucm:hide -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/fix3759.output.md b/unison-src/transcripts/fix3759.output.md index d4f1d9b2a1..1102f45357 100644 --- a/unison-src/transcripts/fix3759.output.md +++ b/unison-src/transcripts/fix3759.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison unique type codebase.Foo = Foo Woot.state : Nat @@ -9,7 +8,7 @@ Woot.frobnicate : Nat Woot.frobnicate = 43 ``` -```unison +``` unison unique type Oog.Foo = Foo Text unique ability Blah where @@ -48,7 +47,7 @@ blah.frobnicate = "Yay!" > blah.frobnicate Text.++ " 🎉" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3773.md b/unison-src/transcripts/fix3773.md index 1a0ab22c78..991db6991f 100644 --- a/unison-src/transcripts/fix3773.md +++ b/unison-src/transcripts/fix3773.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix3773.output.md b/unison-src/transcripts/fix3773.output.md index 09027c3a11..360dd25783 100644 --- a/unison-src/transcripts/fix3773.output.md +++ b/unison-src/transcripts/fix3773.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison foo = _ = 1 _ = 22 @@ -8,7 +7,7 @@ foo = > foo + 20 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4172.md b/unison-src/transcripts/fix4172.md index 2c7d6c3b14..faaa934756 100644 --- a/unison-src/transcripts/fix4172.md +++ b/unison-src/transcripts/fix4172.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -17,8 +17,8 @@ allowDebug = debug [1,2,3] ``` ```ucm -.> add -.> test +scratch/main> add +scratch/main> test ``` ```unison @@ -26,6 +26,6 @@ bool = false ``` ```ucm:error -.> update.old -.> test +scratch/main> update.old +scratch/main> test ``` diff --git a/unison-src/transcripts/fix4172.output.md b/unison-src/transcripts/fix4172.output.md index 59a5d83b87..b94add30ab 100644 --- a/unison-src/transcripts/fix4172.output.md +++ b/unison-src/transcripts/fix4172.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison debug a = match Debug.toText a with None -> "" Some (Left a) -> a @@ -12,7 +11,7 @@ bool = true allowDebug = debug [1,2,3] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -35,8 +34,8 @@ allowDebug = debug [1,2,3] ✅ Passed Yay ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -45,22 +44,22 @@ allowDebug = debug [1,2,3] debug : a -> Text t1 : [Result] -.> test +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ t1 Yay + 1. t1 ◉ Yay ✅ 1 test(s) passing - Tip: Use view t1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison bool = false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -74,14 +73,14 @@ bool = false bool : Boolean ``` -```ucm -.> update.old +``` ucm +scratch/main> update.old ⍟ I've updated these names to your new definition: bool : Boolean -.> test +scratch/main> test ✅ @@ -91,10 +90,10 @@ bool = false New test results: - ✗ t1 [1, 2, 3] + 1. t1 ✗ [1, 2, 3] 🚫 1 test(s) failing - Tip: Use view t1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/fix4280.md b/unison-src/transcripts/fix4280.md index f4cf09a011..d994a42595 100644 --- a/unison-src/transcripts/fix4280.md +++ b/unison-src/transcripts/fix4280.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix4280.output.md b/unison-src/transcripts/fix4280.output.md index 8b918418f8..65561ba2a5 100644 --- a/unison-src/transcripts/fix4280.output.md +++ b/unison-src/transcripts/fix4280.output.md @@ -1,4 +1,4 @@ -```unison +``` unison foo.bar._baz = 5 bonk : Nat @@ -7,7 +7,7 @@ bonk = _baz ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4397.output.md b/unison-src/transcripts/fix4397.output.md index e80ab21d49..5d62c12276 100644 --- a/unison-src/transcripts/fix4397.output.md +++ b/unison-src/transcripts/fix4397.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type Foo f = Foo (f ()) unique type Baz = Baz (Foo Bar) @@ -7,7 +7,7 @@ unique type Bar = Bar Baz ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4415.output.md b/unison-src/transcripts/fix4415.output.md index b6d881fa2a..b17f16ddc4 100644 --- a/unison-src/transcripts/fix4415.output.md +++ b/unison-src/transcripts/fix4415.output.md @@ -1,10 +1,9 @@ - -```unison +``` unison unique type Foo = Foo unique type sub.Foo = ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4424.md b/unison-src/transcripts/fix4424.md index 19963478f0..8fb4d14bab 100644 --- a/unison-src/transcripts/fix4424.md +++ b/unison-src/transcripts/fix4424.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Some basics: @@ -13,7 +13,7 @@ countCat = cases ``` ```ucm -.> add +scratch/main> add ``` Now I want to add a constructor. @@ -23,5 +23,5 @@ unique type Rat.Dog = Bird | Mouse ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/fix4424.output.md b/unison-src/transcripts/fix4424.output.md index bb00ce7303..2c7c4b4b63 100644 --- a/unison-src/transcripts/fix4424.output.md +++ b/unison-src/transcripts/fix4424.output.md @@ -1,6 +1,6 @@ Some basics: -```unison +``` unison unique type Cat.Dog = Mouse Nat unique type Rat.Dog = Bird @@ -8,8 +8,8 @@ countCat = cases Cat.Dog.Mouse x -> Bird ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -20,12 +20,12 @@ countCat = cases ``` Now I want to add a constructor. -```unison +``` unison unique type Rat.Dog = Bird | Mouse ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/fix4482.output.md b/unison-src/transcripts/fix4482.output.md index d61ddd6657..5f641c2047 100644 --- a/unison-src/transcripts/fix4482.output.md +++ b/unison-src/transcripts/fix4482.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.foo0.lib.bonk1.bar = 203 lib.foo0.baz = 1 lib.foo1.zonk = 204 @@ -6,7 +6,7 @@ lib.foo1.lib.bonk2.qux = 1 mybar = bar + bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,7 +23,7 @@ mybar = bar + bar mybar : Nat ``` -```ucm +``` ucm myproj/main> add ⍟ I've added these definitions: @@ -53,7 +53,7 @@ myproj/main> upgrade foo0 foo1 to delete the temporary branch and switch back to main. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u mybar : Nat mybar = use Nat + diff --git a/unison-src/transcripts/fix4498.md b/unison-src/transcripts/fix4498.md index d1781e2e33..5e8918b300 100644 --- a/unison-src/transcripts/fix4498.md +++ b/unison-src/transcripts/fix4498.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,7 +10,7 @@ myterm = foo + 2 ``` ```ucm -.> add -.> view myterm +scratch/main> add +scratch/main> view myterm ``` diff --git a/unison-src/transcripts/fix4498.output.md b/unison-src/transcripts/fix4498.output.md index e13c5f8f09..49cc9735f2 100644 --- a/unison-src/transcripts/fix4498.output.md +++ b/unison-src/transcripts/fix4498.output.md @@ -1,11 +1,11 @@ -```unison +``` unison lib.dep0.bonk.foo = 5 lib.dep0.zonk.foo = "hi" lib.dep0.lib.dep1.foo = 6 myterm = foo + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,8 +21,8 @@ myterm = foo + 2 myterm : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ myterm = foo + 2 lib.dep0.zonk.foo : Text myterm : Nat -.> view myterm +scratch/main> view myterm myterm : Nat myterm = diff --git a/unison-src/transcripts/fix4515.output.md b/unison-src/transcripts/fix4515.output.md index e2f03e9d5a..9e4b3ee657 100644 --- a/unison-src/transcripts/fix4515.output.md +++ b/unison-src/transcripts/fix4515.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Foo1 unique type Bar = X Foo unique type Baz = X Foo @@ -8,7 +8,7 @@ useBar = cases Bar.X _ -> 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ useBar = cases useBar : Bar -> Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: @@ -35,11 +35,11 @@ myproject/main> add useBar : Bar -> Nat ``` -```unison +``` unison unique type Foo = Foo1 | Foo2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -53,7 +53,7 @@ unique type Foo = Foo1 | Foo2 type Foo ``` -```ucm +``` ucm myproject/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/fix4528.output.md b/unison-src/transcripts/fix4528.output.md index 4715b6f47f..0266eef0a2 100644 --- a/unison-src/transcripts/fix4528.output.md +++ b/unison-src/transcripts/fix4528.output.md @@ -1,11 +1,11 @@ -```unison +``` unison structural type Foo = MkFoo Nat main : () -> Foo main _ = MkFoo 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ main _ = MkFoo 5 main : 'Foo ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix4556.md b/unison-src/transcripts/fix4556.md index d4775b587b..1a0bbe25d7 100644 --- a/unison-src/transcripts/fix4556.md +++ b/unison-src/transcripts/fix4556.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,7 +10,7 @@ hey = foo.hello ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,5 +18,5 @@ thing = 2 ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/fix4556.output.md b/unison-src/transcripts/fix4556.output.md index d65321a311..23bdc3a9f2 100644 --- a/unison-src/transcripts/fix4556.output.md +++ b/unison-src/transcripts/fix4556.output.md @@ -1,11 +1,11 @@ -```unison +``` unison thing = 3 foo.hello = 5 + thing bar.hello = 5 + thing hey = foo.hello ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,8 +21,8 @@ hey = foo.hello thing : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -32,11 +32,11 @@ hey = foo.hello thing : Nat ``` -```unison +``` unison thing = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,8 +50,8 @@ thing = 2 thing : Nat ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/fix4592.md b/unison-src/transcripts/fix4592.md index cf272e1948..1118a281fb 100644 --- a/unison-src/transcripts/fix4592.md +++ b/unison-src/transcripts/fix4592.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison diff --git a/unison-src/transcripts/fix4592.output.md b/unison-src/transcripts/fix4592.output.md index d1711bb55b..a6a05b76d6 100644 --- a/unison-src/transcripts/fix4592.output.md +++ b/unison-src/transcripts/fix4592.output.md @@ -1,9 +1,9 @@ -```unison +``` unison doc = {{ {{ bug "bug" 52 }} }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4618.md b/unison-src/transcripts/fix4618.md index 3755f10996..1d69f1ac52 100644 --- a/unison-src/transcripts/fix4618.md +++ b/unison-src/transcripts/fix4618.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -8,7 +8,7 @@ unique type Bugs.Zonk = Bugs ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,5 +17,5 @@ unique type Bugs = ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/fix4618.output.md b/unison-src/transcripts/fix4618.output.md index ee988cf57f..a364ddc8f1 100644 --- a/unison-src/transcripts/fix4618.output.md +++ b/unison-src/transcripts/fix4618.output.md @@ -1,9 +1,9 @@ -```unison +``` unison foo = 5 unique type Bugs.Zonk = Bugs ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,8 +17,8 @@ unique type Bugs.Zonk = Bugs foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -26,12 +26,12 @@ unique type Bugs.Zonk = Bugs foo : Nat ``` -```unison +``` unison foo = 4 unique type Bugs = ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,8 +49,8 @@ unique type Bugs = foo : Nat ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/fix4722.md b/unison-src/transcripts/fix4722.md index e674df56b6..983e324f74 100644 --- a/unison-src/transcripts/fix4722.md +++ b/unison-src/transcripts/fix4722.md @@ -9,7 +9,7 @@ expected type into each case, allowing top-level annotations to act like annotations on each case. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix4722.output.md b/unison-src/transcripts/fix4722.output.md index 85611e9d91..faa963b196 100644 --- a/unison-src/transcripts/fix4722.output.md +++ b/unison-src/transcripts/fix4722.output.md @@ -1,14 +1,13 @@ - Tests an improvement to type checking related to abilities. -`foo` below typechecks fine as long as all the branches are _checked_ +`foo` below typechecks fine as long as all the branches are *checked* against their expected type. However, it's annoying to have to annotate them. The old code was checking a match by just synthesizing and subtyping, but we can instead check a match by pushing the expected type into each case, allowing top-level annotations to act like annotations on each case. -```unison +``` unison ability X a where yield : {X a} () ability Y where y : () @@ -35,7 +34,7 @@ foo = cases f (_ -> ()) (foo l) (foo r) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4780.md b/unison-src/transcripts/fix4780.md index a8fad41440..f1ebdad567 100644 --- a/unison-src/transcripts/fix4780.md +++ b/unison-src/transcripts/fix4780.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Just a simple test case to see whether partially applied diff --git a/unison-src/transcripts/fix4780.output.md b/unison-src/transcripts/fix4780.output.md index 9338c39660..5fefbd4ccf 100644 --- a/unison-src/transcripts/fix4780.output.md +++ b/unison-src/transcripts/fix4780.output.md @@ -1,11 +1,11 @@ Just a simple test case to see whether partially applied builtins decompile properly. -```unison +``` unison > (+) 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4898.md b/unison-src/transcripts/fix4898.md index 9bc68041b2..6d618d82b0 100644 --- a/unison-src/transcripts/fix4898.md +++ b/unison-src/transcripts/fix4898.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ redouble x = double x + double x ``` ```ucm -.> add -.> dependents double -.> delete.term 1 +scratch/main> add +scratch/main> dependents double +scratch/main> delete.term 1 ``` diff --git a/unison-src/transcripts/fix4898.output.md b/unison-src/transcripts/fix4898.output.md index dceafc4cb3..9bacabb90d 100644 --- a/unison-src/transcripts/fix4898.output.md +++ b/unison-src/transcripts/fix4898.output.md @@ -1,10 +1,10 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison double : Int -> Int double x = x + x @@ -12,7 +12,7 @@ redouble : Int -> Int redouble x = double x + double x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,15 +26,15 @@ redouble x = double x + double x redouble : Int -> Int ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: double : Int -> Int redouble : Int -> Int -.> dependents double +scratch/main> dependents double Dependents of: double @@ -45,7 +45,7 @@ redouble x = double x + double x Tip: Try `view 1` to see the source of any numbered item in the above list. -.> delete.term 1 +scratch/main> delete.term 1 Done. diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index a9fe9ee5d0..005e47585e 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -1,16 +1,16 @@ -```ucm +``` ucm test-5055/main> builtins.merge Done. ``` -```unison +``` unison foo.add x y = x Int.+ y foo.subtract x y = x Int.- y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ foo.subtract x y = x Int.- y foo.subtract : Int -> Int -> Int ``` -```ucm +``` ucm test-5055/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix5080.md b/unison-src/transcripts/fix5080.md new file mode 100644 index 0000000000..5c343603de --- /dev/null +++ b/unison-src/transcripts/fix5080.md @@ -0,0 +1,18 @@ +```ucm:hide +scratch/main> builtins.merge lib.builtins +``` + +```unison +test> fix5080.tests.success = [Ok "success"] +test> fix5080.tests.failure = [Fail "fail"] +``` + +```ucm:error +scratch/main> add +scratch/main> test +``` + +```ucm +scratch/main> delete.term 2 +scratch/main> test +``` diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md new file mode 100644 index 0000000000..f64f9c84ff --- /dev/null +++ b/unison-src/transcripts/fix5080.output.md @@ -0,0 +1,67 @@ +``` unison +test> fix5080.tests.success = [Ok "success"] +test> fix5080.tests.failure = [Fail "fail"] +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + fix5080.tests.failure : [Result] + fix5080.tests.success : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | test> fix5080.tests.success = [Ok "success"] + + ✅ Passed success + + 2 | test> fix5080.tests.failure = [Fail "fail"] + + 🚫 FAILED fail + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + fix5080.tests.failure : [Result] + fix5080.tests.success : [Result] + +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. fix5080.tests.success ◉ success + + 2. fix5080.tests.failure ✗ fail + + 🚫 1 test(s) failing, ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. + +``` +``` ucm +scratch/main> delete.term 2 + + Done. + +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. fix5080.tests.success ◉ success + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. + +``` diff --git a/unison-src/transcripts/fix5141.md b/unison-src/transcripts/fix5141.md new file mode 100644 index 0000000000..0536b6e0a0 --- /dev/null +++ b/unison-src/transcripts/fix5141.md @@ -0,0 +1,5 @@ + diff --git a/unison-src/transcripts/fix5141.output.md b/unison-src/transcripts/fix5141.output.md new file mode 100644 index 0000000000..ab031fee02 --- /dev/null +++ b/unison-src/transcripts/fix5141.output.md @@ -0,0 +1,6 @@ + + diff --git a/unison-src/transcripts/fix5168.md b/unison-src/transcripts/fix5168.md new file mode 100644 index 0000000000..2eda5f0215 --- /dev/null +++ b/unison-src/transcripts/fix5168.md @@ -0,0 +1,4 @@ +The `edit` seems to suppress a following ```` ```unison ```` block: +```unison +b = 2 +``` diff --git a/unison-src/transcripts/fix5168.output.md b/unison-src/transcripts/fix5168.output.md new file mode 100644 index 0000000000..5a7c35e339 --- /dev/null +++ b/unison-src/transcripts/fix5168.output.md @@ -0,0 +1,19 @@ +The `edit` seems to suppress a following ` ```unison ` block: + +``` unison +b = 2 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + b : ##Nat + +``` diff --git a/unison-src/transcripts/fix614.md b/unison-src/transcripts/fix614.md index 3e0ad6c76b..3bc69c27c9 100644 --- a/unison-src/transcripts/fix614.md +++ b/unison-src/transcripts/fix614.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This transcript demonstrates that Unison forces actions in blocks to have a return type of `()`. @@ -16,7 +16,7 @@ ex1 = do ``` ```ucm:hide -.> add +scratch/main> add ``` This does not typecheck, we've accidentally underapplied `Stream.emit`: diff --git a/unison-src/transcripts/fix614.output.md b/unison-src/transcripts/fix614.output.md index b679698eb6..97ec65e00a 100644 --- a/unison-src/transcripts/fix614.output.md +++ b/unison-src/transcripts/fix614.output.md @@ -2,7 +2,7 @@ This transcript demonstrates that Unison forces actions in blocks to have a retu This works, as expected: -```unison +``` unison structural ability Stream a where emit : a -> () ex1 = do @@ -11,7 +11,7 @@ ex1 = do 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,13 +27,13 @@ ex1 = do ``` This does not typecheck, we've accidentally underapplied `Stream.emit`: -```unison +``` unison ex2 = do Stream.emit 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,13 +49,13 @@ ex2 = do ``` We can explicitly ignore an unused result like so: -```unison +``` unison ex3 = do _ = Stream.emit () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -70,7 +70,7 @@ ex3 = do ``` Using a helper function like `void` also works fine: -```unison +``` unison void x = () ex4 = @@ -78,7 +78,7 @@ ex4 = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -94,13 +94,13 @@ ex4 = ``` One more example: -```unison +``` unison ex4 = [1,2,3] -- no good () ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix689.md b/unison-src/transcripts/fix689.md index b22106eed4..a75468b281 100644 --- a/unison-src/transcripts/fix689.md +++ b/unison-src/transcripts/fix689.md @@ -1,7 +1,7 @@ Tests the fix for https://github.com/unisonweb/unison/issues/689 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ``` unison diff --git a/unison-src/transcripts/fix689.output.md b/unison-src/transcripts/fix689.output.md index 9bb9dcc064..ed8ea04102 100644 --- a/unison-src/transcripts/fix689.output.md +++ b/unison-src/transcripts/fix689.output.md @@ -1,13 +1,13 @@ Tests the fix for https://github.com/unisonweb/unison/issues/689 -```unison +``` unison structural ability SystemTime where systemTime : ##Nat tomorrow = '(SystemTime.systemTime + 24 * 60 * 60) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix693.md b/unison-src/transcripts/fix693.md index bcb714af97..f45d2eab15 100644 --- a/unison-src/transcripts/fix693.md +++ b/unison-src/transcripts/fix693.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -12,7 +12,7 @@ structural ability Abort where ``` ```ucm -.> add +scratch/main> add ``` This code should not type check. The match on X.x ought to introduce a diff --git a/unison-src/transcripts/fix693.output.md b/unison-src/transcripts/fix693.output.md index 6d869d63a1..35e07bec56 100644 --- a/unison-src/transcripts/fix693.output.md +++ b/unison-src/transcripts/fix693.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural ability X t where x : t -> a -> a @@ -7,7 +6,7 @@ structural ability Abort where abort : a ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,8 +20,8 @@ structural ability Abort where structural ability X t ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -35,14 +34,14 @@ skolem variable `a` such that `c : a` and the continuation has type `a ->{X} b`. Thus, `handle c with h : Optional a`, which is not the correct result type. -```unison +``` unison h0 : Request {X t} b -> Optional b h0 req = match req with { X.x _ c -> _ } -> handle c with h0 { d } -> Some d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -63,14 +62,14 @@ h0 req = match req with ``` This code should not check because `t` does not match `b`. -```unison +``` unison h1 : Request {X t} b -> Optional b h1 req = match req with { X.x t _ -> _ } -> handle t with h1 { d } -> Some d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -92,14 +91,14 @@ h1 req = match req with This code should not check for reasons similar to the first example, but with the continuation rather than a parameter. -```unison +``` unison h2 : Request {Abort} r -> r h2 req = match req with { Abort.abort -> k } -> handle k 5 with h2 { r } -> r ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -114,7 +113,7 @@ h2 req = match req with ``` This should work fine. -```unison +``` unison h3 : Request {X b, Abort} b -> Optional b h3 = cases { r } -> Some r @@ -122,7 +121,7 @@ h3 = cases { X.x b _ -> _ } -> Some b ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix845.md b/unison-src/transcripts/fix845.md index 4e361ca7cc..99e4262455 100644 --- a/unison-src/transcripts/fix845.md +++ b/unison-src/transcripts/fix845.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Add `List.zonk` to the codebase: @@ -14,7 +14,7 @@ Text.zonk txt = txt ++ "!! " ``` ```ucm:hide -.> add +scratch/main> add ``` Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in the codebase). This should fail: diff --git a/unison-src/transcripts/fix845.output.md b/unison-src/transcripts/fix845.output.md index fbdc9fc732..c192583c63 100644 --- a/unison-src/transcripts/fix845.output.md +++ b/unison-src/transcripts/fix845.output.md @@ -1,7 +1,6 @@ - Add `List.zonk` to the codebase: -```unison +``` unison List.zonk : [a] -> [a] List.zonk xs = xs @@ -9,7 +8,7 @@ Text.zonk : Text -> Text Text.zonk txt = txt ++ "!! " ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,12 +24,12 @@ Text.zonk txt = txt ++ "!! " ``` Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in the codebase). This should fail: -```unison +``` unison -- should not typecheck as there's no `Blah.zonk` in the codebase > Blah.zonk [1,2,3] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -52,7 +51,7 @@ Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in th ``` Here's another example, just checking that TDNR works for definitions in the same file: -```unison +``` unison foo.bar.baz = 42 qux.baz = "hello" @@ -62,7 +61,7 @@ ex = baz ++ ", world!" > ex ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -86,13 +85,13 @@ ex = baz ++ ", world!" ``` Here's another example, checking that TDNR works when multiple codebase definitions have matching names: -```unison +``` unison ex = zonk "hi" > ex ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -114,7 +113,7 @@ ex = zonk "hi" ``` Last example, showing that TDNR works when there are multiple matching names in both the file and the codebase: -```unison +``` unison woot.zonk = "woot" woot2.zonk = 9384 @@ -124,7 +123,7 @@ ex = zonk "hi" -- should resolve to Text.zonk, from the codebase > ex ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix849.md b/unison-src/transcripts/fix849.md index 4d111f9cc1..63c40e8212 100644 --- a/unison-src/transcripts/fix849.md +++ b/unison-src/transcripts/fix849.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` See [this ticket](https://github.com/unisonweb/unison/issues/849). diff --git a/unison-src/transcripts/fix849.output.md b/unison-src/transcripts/fix849.output.md index 33720e550e..c6c5c13904 100644 --- a/unison-src/transcripts/fix849.output.md +++ b/unison-src/transcripts/fix849.output.md @@ -1,13 +1,12 @@ - See [this ticket](https://github.com/unisonweb/unison/issues/849). -```unison +``` unison x = 42 > x ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix942.md b/unison-src/transcripts/fix942.md index 5c12cb8c06..5cbf16ffb1 100644 --- a/unison-src/transcripts/fix942.md +++ b/unison-src/transcripts/fix942.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` First we add some code: @@ -11,7 +11,7 @@ z = y + 2 ``` ```ucm -.> add +scratch/main> add ``` Now we edit `x` to be `7`, which should make `z` equal `10`: @@ -21,8 +21,8 @@ x = 7 ``` ```ucm -.> update -.> view x y z +scratch/main> update +scratch/main> view x y z ``` Uh oh! `z` is still referencing the old version. Just to confirm: @@ -32,6 +32,6 @@ test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ``` ```ucm -.> add -.> test +scratch/main> add +scratch/main> test ``` diff --git a/unison-src/transcripts/fix942.output.md b/unison-src/transcripts/fix942.output.md index fd5f055d22..13dd97532b 100644 --- a/unison-src/transcripts/fix942.output.md +++ b/unison-src/transcripts/fix942.output.md @@ -1,12 +1,12 @@ First we add some code: -```unison +``` unison x = 0 y = x + 1 z = y + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,8 +21,8 @@ z = y + 2 z : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -33,11 +33,11 @@ z = y + 2 ``` Now we edit `x` to be `7`, which should make `z` equal `10`: -```unison +``` unison x = 7 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,8 +51,8 @@ x = 7 x : Nat ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -63,7 +63,7 @@ x = 7 Done. -.> view x y z +scratch/main> view x y z x : Nat x = 7 @@ -79,13 +79,13 @@ x = 7 y + 2 ``` -Uh oh! `z` is still referencing the old version. Just to confirm: +Uh oh\! `z` is still referencing the old version. Just to confirm: -```unison +``` unison test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -105,21 +105,21 @@ test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ✅ Passed great ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: t1 : [Result] -.> test +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ t1 great + 1. t1 ◉ great ✅ 1 test(s) passing - Tip: Use view t1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/fix987.md b/unison-src/transcripts/fix987.md index 0db69b1d78..5eb2a73bbc 100644 --- a/unison-src/transcripts/fix987.md +++ b/unison-src/transcripts/fix987.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` First we'll add a definition: @@ -18,7 +18,7 @@ spaceAttack1 x = Add it to the codebase: ```ucm -.> add +scratch/main> add ``` Now we'll try to add a different definition that runs the actions in a different order. This should work fine: @@ -31,7 +31,7 @@ spaceAttack2 x = ``` ```ucm -.> add +scratch/main> add ``` Previously, this would fail because the hashing algorithm was being given one big let rec block whose binding order was normalized. diff --git a/unison-src/transcripts/fix987.output.md b/unison-src/transcripts/fix987.output.md index 5f6119c225..a128fa6c0a 100644 --- a/unison-src/transcripts/fix987.output.md +++ b/unison-src/transcripts/fix987.output.md @@ -1,7 +1,6 @@ - First we'll add a definition: -```unison +``` unison structural ability DeathStar where attack : Text -> () @@ -11,7 +10,7 @@ spaceAttack1 x = "All done" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,8 +26,8 @@ spaceAttack1 x = ``` Add it to the codebase: -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -38,14 +37,14 @@ Add it to the codebase: ``` Now we'll try to add a different definition that runs the actions in a different order. This should work fine: -```unison +``` unison spaceAttack2 x = z = attack "neptune" y = attack "saturn" "All done" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,8 +57,8 @@ spaceAttack2 x = spaceAttack2 : x ->{DeathStar} Text ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -67,3 +66,4 @@ spaceAttack2 x = ``` Previously, this would fail because the hashing algorithm was being given one big let rec block whose binding order was normalized. + diff --git a/unison-src/transcripts/formatter.md b/unison-src/transcripts/formatter.md index 3848c0ba99..d2a921b2fc 100644 --- a/unison-src/transcripts/formatter.md +++ b/unison-src/transcripts/formatter.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -88,7 +88,7 @@ with a strike-through block~ ``` ```ucm -.> debug.format +scratch/main> debug.format ``` Formatter should leave things alone if the file doesn't typecheck. @@ -98,5 +98,5 @@ brokenDoc = {{ hello }} + 1 ``` ```ucm -.> debug.format +scratch/main> debug.format ``` diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md index 95af2a545d..54c9a12327 100644 --- a/unison-src/transcripts/formatter.output.md +++ b/unison-src/transcripts/formatter.output.md @@ -1,4 +1,4 @@ -```unison +``` unison {{ # Doc This is a *doc*! @@ -83,11 +83,11 @@ with a strike-through block~ }} ``` -```ucm -.> debug.format +``` ucm +scratch/main> debug.format ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u x.doc = {{ # Doc This is a **doc**! @@ -142,7 +142,7 @@ provide a action = h = cases { ask -> resume } -> handle resume a with h { r } -> r - handle !action with h + handle action() with h Optional.doc = {{ A Doc before a type }} structural type Optional a = More Text | Some | Other a | None Nat @@ -167,11 +167,11 @@ multilineBold = Formatter should leave things alone if the file doesn't typecheck. -```unison +``` unison brokenDoc = {{ hello }} + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -199,7 +199,7 @@ brokenDoc = {{ hello }} + 1 (Nat.+) : Nat -> Nat -> Nat ``` -```ucm -.> debug.format +``` ucm +scratch/main> debug.format ``` diff --git a/unison-src/transcripts/fuzzy-options.md b/unison-src/transcripts/fuzzy-options.md index 13d953c938..e460ce923a 100644 --- a/unison-src/transcripts/fuzzy-options.md +++ b/unison-src/transcripts/fuzzy-options.md @@ -5,14 +5,14 @@ If an argument is required but doesn't have a fuzzy resolver, the command should ```ucm:error -- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver -.> move.term +scratch/main> move.term ``` If a fuzzy resolver doesn't have any options available it should print a message instead of opening an empty fuzzy-select. ```ucm:error -.empty> view +scratch/empty> view ``` @@ -25,21 +25,21 @@ nested.optionTwo = 2 Definition args ```ucm -.> add -.> debug.fuzzy-options view _ +scratch/main> add +scratch/main> debug.fuzzy-options view _ ``` Namespace args ```ucm -.> add -.> debug.fuzzy-options find-in _ +scratch/main> add +scratch/main> debug.fuzzy-options find-in _ ``` Project Branch args ```ucm myproject/main> branch mybranch -.> debug.fuzzy-options switch _ +scratch/main> debug.fuzzy-options switch _ ``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md index f48f5cd6fb..d83fd4341b 100644 --- a/unison-src/transcripts/fuzzy-options.output.md +++ b/unison-src/transcripts/fuzzy-options.output.md @@ -2,10 +2,9 @@ If an argument is required but doesn't have a fuzzy resolver, the command should just print the help. - -```ucm +``` ucm -- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver -.> move.term +scratch/main> move.term `move.term foo bar` renames `foo` to `bar`. @@ -13,17 +12,15 @@ If an argument is required but doesn't have a fuzzy resolver, the command should If a fuzzy resolver doesn't have any options available it should print a message instead of opening an empty fuzzy-select. -```ucm - ☝️ The namespace .empty is empty. - -.empty> view +``` ucm +scratch/empty> view ⚠️ Sorry, I was expecting an argument for the definition to view, and I couldn't find any to suggest to you. 😅 ``` -```unison +``` unison optionOne = 1 nested.optionTwo = 2 @@ -31,17 +28,15 @@ nested.optionTwo = 2 Definition args -```ucm - ☝️ The namespace . is empty. - -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: nested.optionTwo : ##Nat optionOne : ##Nat -.> debug.fuzzy-options view _ +scratch/main> debug.fuzzy-options view _ Select a definition to view: * optionOne @@ -50,13 +45,13 @@ Definition args ``` Namespace args -```ucm -.> add +``` ucm +scratch/main> add ⊡ Ignored previously added definitions: nested.optionTwo optionOne -.> debug.fuzzy-options find-in _ +scratch/main> debug.fuzzy-options find-in _ Select a namespace: * nested @@ -64,7 +59,7 @@ Namespace args ``` Project Branch args -```ucm +``` ucm myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. @@ -72,11 +67,14 @@ myproject/main> branch mybranch Tip: To merge your work back into the main branch, first `switch /main` then `merge /mybranch`. -.> debug.fuzzy-options switch _ +scratch/main> debug.fuzzy-options switch _ Select a project or branch to switch to: * myproject/main * myproject/mybranch + * scratch/empty + * scratch/main * myproject + * scratch ``` diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index b055ba9689..081548ea11 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -1,11 +1,11 @@ Just a bunch of random parse errors to test the error formatting. -```unison +``` unison x = foo.123 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,25 +22,27 @@ x = * identifier (ex: abba1, snake_case, .foo.bar#xyz, .foo.++#xyz, or 🌻) ``` -```unison +``` unison namespace.blah = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. - The identifier used here isn't allowed to be a reserved keyword: + The identifier `namespace` used here is a reserved keyword: 1 | namespace.blah = 1 + You can avoid this problem either by renaming the identifier + or wrapping it in backticks (like `namespace` ). ``` -```unison +``` unison x = 1 ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,11 +52,11 @@ x = 1 ] ``` -```unison +``` unison x = a.#abc ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -64,13 +66,31 @@ x = a.#abc I was surprised to find a '.' here. + I was expecting one of these instead: + + * and + * bang + * do + * false + * force + * handle + * if + * infixApp + * let + * newline or semicolon + * or + * quote + * termLink + * true + * tuple + * typeLink ``` -```unison +``` unison x = "hi ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -86,11 +106,11 @@ x = "hi * literal character ``` -```unison +``` unison y : a ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/hello.md b/unison-src/transcripts/hello.md index 187eb86ec3..255da910d6 100644 --- a/unison-src/transcripts/hello.md +++ b/unison-src/transcripts/hello.md @@ -1,8 +1,7 @@ - # Hello! ```ucm:hide -.> builtins.merge +scratch/main> builtins.mergeio ``` This markdown file is also a Unison transcript file. Transcript files are an easy way to create self-documenting Unison programs, libraries, and tutorials. @@ -33,8 +32,8 @@ x = 42 Let's go ahead and add that to the codebase, then make sure it's there: ```ucm -.> add -.> view x +scratch/main> add +scratch/main> view x ``` If `view` returned no results, the transcript would fail at this point. @@ -50,13 +49,13 @@ y = 99 This works for `ucm` blocks as well. ```ucm:hide -.> rename.term x answerToUltimateQuestionOfLife +scratch/main> rename.term x answerToUltimateQuestionOfLife ``` Doing `unison:hide:all` hides the block altogether, both input and output - this is useful for doing behind-the-scenes control of `ucm`'s state. ```unison:hide:all -> [: you won't see me :] +> {{ you won't see me }} ``` ## Expecting failures diff --git a/unison-src/transcripts/hello.output.md b/unison-src/transcripts/hello.output.md index 8104114e03..b486a40213 100644 --- a/unison-src/transcripts/hello.output.md +++ b/unison-src/transcripts/hello.output.md @@ -1,29 +1,27 @@ - -# Hello! +# Hello\! This markdown file is also a Unison transcript file. Transcript files are an easy way to create self-documenting Unison programs, libraries, and tutorials. The format is just a regular markdown file with some fenced code blocks that are typechecked and elaborated by `ucm`. For example, you can call this transcript via: -``` +``` $ ucm transcript hello.md - ``` This runs it on a freshly generated empty codebase. Alternately `ucm transcript.fork --codebase /path/to/code hello.md` runs the transcript on a freshly generated copy of the provided codebase. Do `ucm help` to learn more about usage. Fenced code blocks of type `unison` and `ucm` are treated specially: -* `ucm` blocks are executed, and the output is interleaved into the output markdown file after each command, replacing the original `ucm` block. -* `unison` blocks are typechecked, and a `ucm` block with the output of typechecking and execution of the file is inserted immediately afterwards. + - `ucm` blocks are executed, and the output is interleaved into the output markdown file after each command, replacing the original `ucm` block. + - `unison` blocks are typechecked, and a `ucm` block with the output of typechecking and execution of the file is inserted immediately afterwards. Take a look at [the elaborated output](hello.output.md) to see what this file looks like after passing through the transcript runner. -## Let's try it out!! +## Let's try it out\!\! In the `unison` fenced block, you can give an (optional) file name (defaults to `scratch.u`), like so: -```unison +``` unison --- title: myfile.u --- @@ -31,8 +29,7 @@ x = 42 ``` - -```ucm +``` ucm Loading changes detected in myfile.u. @@ -47,14 +44,14 @@ x = 42 ``` Let's go ahead and add that to the codebase, then make sure it's there: -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: x : Nat -.> view x +scratch/main> view x x : Nat x = 42 @@ -66,7 +63,7 @@ If `view` returned no results, the transcript would fail at this point. You may not always want to view the output of typechecking and evaluation every time, in which case, you can add `:hide` to the block. For instance: -```unison +``` unison y = 99 ``` @@ -76,14 +73,14 @@ Doing `unison:hide:all` hides the block altogether, both input and output - this ## Expecting failures -Sometimes, you have a block which you are _expecting_ to fail, perhaps because you're illustrating how something would be a type error. Adding `:error` to the block will check for this. For instance, this program has a type error: +Sometimes, you have a block which you are *expecting* to fail, perhaps because you're illustrating how something would be a type error. Adding `:error` to the block will check for this. For instance, this program has a type error: -```unison +``` unison hmm : .builtin.Nat hmm = "Not, in fact, a number" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/help.md b/unison-src/transcripts/help.md new file mode 100644 index 0000000000..79ffa1846d --- /dev/null +++ b/unison-src/transcripts/help.md @@ -0,0 +1,14 @@ +# Shows `help` output + +```ucm +scratch/main> help +scratch/main> help-topics +scratch/main> help-topic filestatus +scratch/main> help-topic messages.disallowedAbsolute +scratch/main> help-topic namespaces +scratch/main> help-topic projects +scratch/main> help-topic remotes +scratch/main> help-topic testcache +``` + +We should add a command to show help for hidden commands also. diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md new file mode 100644 index 0000000000..aad724347c --- /dev/null +++ b/unison-src/transcripts/help.output.md @@ -0,0 +1,980 @@ +# Shows `help` output + +``` ucm +scratch/main> help + + add + `add` adds to the codebase all the definitions from the most recently typechecked file. + + add.preview + `add.preview` previews additions to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. + + add.run + `add.run name` adds to the codebase the result of the most recent `run` command as `name`. + + alias.many (or copy) + `alias.many [relative2...] ` creates + aliases `relative1`, `relative2`, ... in the namespace + `namespace`. + `alias.many foo.foo bar.bar .quux` creates aliases + `.quux.foo.foo` and `.quux.bar.bar`. + + alias.term + `alias.term foo bar` introduces `bar` with the same definition as `foo`. + + alias.type + `alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`. + + api + `api` provides details about the API. + + auth.login + Obtain an authentication session with Unison Share. + `auth.login`authenticates ucm with Unison Share. + + back (or popd) + `back` undoes the last `switch` command. + + branch (or branch.create, create.branch) + `branch foo` forks the current project branch to a new + branch `foo` + `branch /bar foo` forks the branch `bar` of the current + project to a new branch `foo` + + branch.empty (or branch.create-empty, create.empty-branch) + Create a new empty branch. + + branch.reflog (or reflog.branch, reflog) + `branch.reflog` lists all the changes that have affected the current branch. + `branch.reflog /mybranch` lists all the changes that have affected /mybranch. + + branch.rename (or rename.branch) + `branch.rename foo` renames the current branch to `foo` + + branches (or list.branch, ls.branch, branch.list) + `branches` lists all branches in the current project + `branches foo` lists all branches in the project `foo` + + clear + `clear` Clears the screen. + + clone + `clone @unison/json/topic json/my-topic` creates + `json/my-topic` from + the remote branch + `@unison/json/topic` + `clone @unison/base base/` creates `base/main` + from the remote + branch + `@unison/base/main` + `clone @unison/base /main2` creates the branch + `main2` in the + current project from + the remote branch + `@unison/base/main` + `clone /main /main2` creates the branch + `main2` in the + current project from + the remote branch + `main` of the + current project's + associated remote + (see + `help-topics remotes`) + `clone /main my-fork/` creates + `my-fork/main` from + the branch `main` of + the current + project's associated + remote (see + `help-topics remotes`) + + compile (or compile.output) + `compile main file` Outputs a stand alone file that can be + directly loaded and executed by unison. + Said execution will have the effect of + running `!main`. + + create.author + `create.author alicecoder "Alice McGee"` creates `alicecoder` + values in `metadata.authors` and `metadata.copyrightHolders.` + + debug.clear-cache + Clear the watch expression cache + + debug.doc-to-markdown + `debug.doc-to-markdown term.doc` Render a doc to markdown. + + debug.doctor + Analyze your codebase for errors and inconsistencies. + + debug.dump-namespace + Dump the namespace to a text file + + debug.dump-namespace-simple + Dump the namespace to a text file + + debug.file + View details about the most recent successfully typechecked file. + + debug.numberedArgs + Dump the contents of the numbered args state. + + delete + `delete foo` removes the term or type name `foo` from the namespace. + `delete foo bar` removes the term or type name `foo` and `bar` from the namespace. + + delete.branch (or branch.delete) + `delete.branch foo/bar` deletes the branch `bar` in the + project `foo` + `delete.branch /bar` deletes the branch `bar` in the + current project + + delete.namespace + `delete.namespace ` deletes the namespace `foo` + + delete.namespace.force + `delete.namespace.force ` deletes the namespace `foo`,deletion will proceed even if other code depends on definitions in foo. + + delete.project (or project.delete) + `delete.project foo` deletes the local project `foo` + + delete.term + `delete.term foo` removes the term name `foo` from the namespace. + `delete.term foo bar` removes the term name `foo` and `bar` from the namespace. + + delete.term.verbose + `delete.term.verbose foo` removes the term name `foo` from the namespace. + `delete.term.verbose foo bar` removes the term name `foo` and `bar` from the namespace. + + delete.type + `delete.type foo` removes the type name `foo` from the namespace. + `delete.type foo bar` removes the type name `foo` and `bar` from the namespace. + + delete.type.verbose + `delete.type.verbose foo` removes the type name `foo` from the namespace. + `delete.type.verbose foo bar` removes the type name `foo` and `bar` from the namespace. + + delete.verbose + `delete.verbose foo` removes the term or type name `foo` from the namespace. + `delete.verbose foo bar` removes the term or type name `foo` and `bar` from the namespace. + + dependencies + List the dependencies of the specified definition. + + dependents + List the named dependents of the specified definition. + + deprecated.cd (or deprecated.namespace) + Moves your perspective to a different namespace. Deprecated for now because too many important things depend on your perspective selection. + + `deprecated.cd foo.bar` descends into foo.bar from the + current namespace. + `deprecated.cd .cat.dog` sets the current namespace to the + absolute namespace .cat.dog. + `deprecated.cd ..` moves to the parent of the current + namespace. E.g. moves from + '.cat.dog' to '.cat' + `deprecated.cd` invokes a search to select which + namespace to move to, which requires + that `fzf` can be found within your + PATH. + + deprecated.root-reflog + `deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of `branch.reflog` which shows the reflog for the current project. + + diff.namespace + `diff.namespace before after` shows how the namespace `after` + differs from the namespace + `before` + `diff.namespace before` shows how the current namespace + differs from the namespace + `before` + + display + `display foo` prints a rendered version of the term `foo`. + `display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH. + + display.to + `display.to foo` prints a rendered version of the + term `foo` to the given file. + + docs + `docs foo` shows documentation for the definition `foo`. + `docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH. + + docs.to-html + `docs.to-html .path.to.ns doc-dir` Render + all docs + contained + within + the + namespace + `.path.to.ns`, + no matter + how deep, + to html + files in + `doc-dir` + in the + directory + UCM was + run from. + `docs.to-html project0/branch0:a.path /tmp/doc-dir` Renders + all docs + anywhere + in the + namespace + `a.path` + from + `branch0` + of + `project0` + to html + in + `/tmp/doc-dir`. + + edit + `edit foo` prepends the definition of `foo` to the top of the most recently saved file. + `edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH. + + edit.namespace + `edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries. + `edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces. + + find + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find-in + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find-in.all + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find.all + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find.all.verbose + `find.all.verbose` searches for definitions like `find.all`, but includes hashes and aliases in the results. + + find.global + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find.verbose + `find.verbose` searches for definitions like `find`, but includes hashes and aliases in the results. + + fork (or copy.namespace) + `fork src dest` creates + the + namespace + `dest` as + a copy of + `src`. + `fork project0/branch0:a.path project1/branch1:foo` creates + the + namespace + `foo` in + `branch1` + of + `project1` + as a copy + of + `a.path` + in + `project0/branch0`. + `fork srcproject/srcbranch dest` creates + the + namespace + `dest` as + a copy of + the + branch + `srcbranch` + of + `srcproject`. + + help (or ?) + `help` shows general help and `help ` shows help for one command. + + help-topics (or help-topic) + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + + history + `history` Shows the history of the current + path. + `history .foo` Shows history of the path .foo. + `history #9dndk3kbsk13nbpeu` Shows the history of the + namespace with the given hash. + The full hash must be provided. + + io.test (or test.io) + `io.test mytest` Runs `!mytest`, where `mytest` is a delayed + test that can use the `IO` and `Exception` + abilities. + + io.test.all (or test.io.all) + `io.test.all` runs unit tests for the current branch that use + IO + + lib.install (or install.lib) + The `lib.install` command installs a dependency into the `lib` + namespace. + + `lib.install @unison/base/releases/latest` installs the + latest release of + `@unison/base` + `lib.install @unison/base/releases/3.0.0` installs version + 3.0.0 of + `@unison/base` + `lib.install @unison/base/topic` installs the + `topic` branch of + `@unison/base` + + list (or ls, dir) + `list` lists definitions and namespaces at the current + level of the current namespace. + `list foo` lists the 'foo' namespace. + `list .foo` lists the '.foo' namespace. + + load + `load` parses, typechecks, and evaluates the + most recent scratch file. + `load ` parses, typechecks, and evaluates the + given scratch file. + + merge + `merge /branch` merges `branch` into the current branch + + merge.commit (or commit.merge) + `merge.commit` merges a temporary branch created by the + `merge` command back into its parent branch, and removes the + temporary branch. + + For example, if you've done `merge topic` from main, then + `merge.commit` is equivalent to doing + + * switch /main + * merge /merge-topic-into-main + * delete.branch /merge-topic-into-main + + move (or rename) + `move foo bar` renames the term, type, and namespace foo to bar. + + move.namespace (or rename.namespace) + `move.namespace foo bar` renames the path `foo` to `bar`. + + move.term (or rename.term) + `move.term foo bar` renames `foo` to `bar`. + + move.type (or rename.type) + `move.type foo bar` renames `foo` to `bar`. + + names + `names foo` shows the hash and all known names for `foo`. + + names.global + `names.global foo` shows the hash and all known names for + `foo`. + + namespace.dependencies + List the external dependencies of the specified namespace. + + project.create (or create.project) + `project.create` creates a project with a random name + `project.create foo` creates a project named `foo` + + project.reflog (or reflog.project) + `project.reflog` lists all the changes that have affected any branches in the current project. + `project.reflog myproject` lists all the changes that have affected any branches in myproject. + + project.rename (or rename.project) + `project.rename foo` renames the current project to `foo` + + projects (or list.project, ls.project, project.list) + List projects. + + pull + The `pull` command merges a remote namespace into a local + branch + + `pull @unison/base/main` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the current branch + `pull @unison/base/main my-base/topic` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the branch `topic` of + the local `my-base` + project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` + + pull.without-history + The `pull.without-history` command merges a remote namespace + into a local branch without including the remote's history. + This usually results in smaller codebase sizes. + + `pull.without-history @unison/base/main` merges + the + branch + `main` + of the + Unison + Share + hosted + project + `@unison/base` + into + the + current + branch + `pull.without-history @unison/base/main my-base/topic` merges + the + branch + `main` + of the + Unison + Share + hosted + project + `@unison/base` + into + the + branch + `topic` + of the + local + `my-base` + project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` + + push + The `push` command merges a local project or namespace into a + remote project or namespace. + + `push ` publishes the contents of a local + namespace or branch into a remote + namespace or branch. + `push ` publishes the current namespace or + branch into a remote namespace or + branch + `push` publishes the current namespace or + branch. Remote mappings for + namespaces are configured in your + `.unisonConfig` at the key + `RemoteMappings.` where + `` is the current + namespace. Remote mappings for + branches default to the branch that + you cloned from or pushed to + initially. Otherwise, it is pushed to + @/ + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + + push.create + The `push.create` command pushes a local namespace to an empty + remote namespace. + + `push.create remote local` pushes the contents of the local + namespace `local` into the empty + remote namespace `remote`. + `push.create remote` publishes the current namespace + into the empty remote namespace + `remote` + `push.create` publishes the current namespace + into the remote namespace + configured in your `.unisonConfig` + at the key + `RemoteMappings.` where + `` is the current + namespace, then publishes the + current namespace to that + location. + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + + quit (or exit, :q) + Exits the Unison command line interface. + + reflog.global + `reflog.global` lists all recent changes across all projects and branches. + + release.draft (or draft.release) + Draft a release. + + reset + `reset #pvfd222s8n` reset the current namespace to the + hash `#pvfd222s8n` + `reset foo` reset the current namespace to the + state of the `foo` namespace. + `reset #pvfd222s8n /topic` reset the branch `topic` of the + current project to the causal + `#pvfd222s8n`. + + If you make a mistake using reset, consult the `branch.reflog` + command and use another `reset` command to return to a + previous state. + + rewrite (or sfind.replace) + `rewrite rule1` rewrites definitions in the latest scratch file. + + The argument `rule1` must refer to a `@rewrite` block or a + function that immediately returns a `@rewrite` block. It can + be in the codebase or scratch file. An example: + + rule1 x = @rewrite term x + 1 ==> Nat.increment x + + Here, `x` will stand in for any expression wherever this + rewrite is applied, so this rule will match `(42+10+11) + 1` + and replace it with `Nat.increment (42+10+11)`. + + See https://unison-lang.org/learn/structured-find to learn more. + + Also see the related command `rewrite.find` + + rewrite.find (or sfind) + `rewrite.find rule1` finds definitions that match any of the + left side(s) of `rule` in the current namespace. + + The argument `rule1` must refer to a `@rewrite` block or a + function that immediately returns a `@rewrite` block. It can + be in the codebase or scratch file. An example: + + -- right of ==> is ignored by this command + rule1 x = @rewrite term x + 1 ==> () + + Here, `x` will stand in for any expression, so this rule will + match `(42+10+11) + 1`. + + See https://unison-lang.org/learn/structured-find to learn more. + + Also see the related command `rewrite` + + run + `run mymain args...` Runs `!mymain`, where `mymain` is + searched for in the most recent + typechecked file, or in the codebase. + Any provided arguments will be passed as + program arguments as though they were + provided at the command line when + running mymain as an executable. + + run.native + `run.native main args` Executes !main using native + compilation via scheme. + + switch + `switch` opens an interactive selector to pick a + project and branch + `switch foo/bar` switches to the branch `bar` in the project + `foo` + `switch foo/` switches to the last branch you visited in + the project `foo` + `switch /bar` switches to the branch `bar` in the current + project + + test + `test` runs unit tests for the current branch + `test foo` runs unit tests for the current branch defined in + namespace `foo` + + test.all + `test.all` runs unit tests for the current branch (including the `lib` namespace). + + todo + `todo` lists the current namespace's outstanding issues, + including conflicted names, dependencies with missing names, + and merge precondition violations. + + ui + `ui` opens the Local UI in the default browser. + + undo + `undo` reverts the most recent change to the codebase. + + update + Adds everything in the most recently typechecked file to the + namespace, replacing existing definitions having the same + name, and attempts to update all the existing dependents + accordingly. If the process can't be completed automatically, + the dependents will be added back to the scratch file for your + review. + + update.old + `update.old` works like `add`, except that if a definition in + the file has the same name as an existing definition, the name + gets updated to point to the new definition. If the old + definition has any dependents, `update` will add those + dependents to a refactoring session, specified by an optional + patch.`update.old` adds all definitions in + the .u file, noting replacements + in the default patch for the + current namespace. + `update.old ` adds all definitions in the .u + file, noting replacements in the + specified patch. + `update.old foo bar` adds `foo`, `bar`, and their + dependents from the .u file, + noting any replacements into the + specified patch. + + update.old.nopatch + `update.old.nopatch` works like `update.old`, except it + doesn't add a patch entry for any updates. Use this when you + want to make changes to definitions without pushing those + changes to dependents beyond your codebase. An example is when + updating docs, or when updating a term you just added.`update.old.nopatch` updates + all definitions in the .u file. + `update.old.nopatch foo bar` updates `foo`, `bar`, and their + dependents from the .u file. + + update.old.preview + `update.old.preview` previews updates to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. + + upgrade + `upgrade old new` upgrades library dependency `lib.old` to + `lib.new`, and, if successful, deletes `lib.old`. + + upgrade.commit (or commit.upgrade) + `upgrade.commit` merges a temporary branch created by the + `upgrade` command back into its parent branch, and removes the + temporary branch. + + For example, if you've done `upgrade foo bar` from main, then + `upgrade.commit` is equivalent to doing + + * switch /main + * merge /upgrade-foo-to-bar + * delete.branch /upgrade-foo-to-bar + + version + Print the version of unison you're running + + view + `view foo` shows definitions named `foo` within your current + namespace. + `view` without arguments invokes a search to select + definitions to view, which requires that `fzf` can be found + within your PATH. + + Supports glob syntax, where ? acts a wildcard, so + `view List.?` will show `List.map`, `List.filter`, etc, but + not `List.map.doc` (since ? only matches 1 name segment). + + view.global + `view.global foo` prints definitions of `foo` within your codebase. + `view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH. + +scratch/main> help-topics + + 🌻 + + Here's a list of topics I can tell you more about: + + filestatus + messages.disallowedAbsolute + namespaces + projects + remotes + testcache + + Example: use `help-topics filestatus` to learn more about that topic. + +scratch/main> help-topic filestatus + + 📓 + + Here's a list of possible status messages you might see for + definitions in a .u file. + + needs update A definition with the same name as an + existing definition. Doing `update` + instead of `add` will turn this failure + into a successful update. + + term/ctor collision A definition with the same name as an + existing constructor for some data type. + Rename your definition or the data type + before trying again to `add` or `update`. + + ctor/term collision A type defined in the file has a + constructor that's named the same as an + existing term. Rename that term or your + constructor before trying again to `add` + or `update`. + + blocked This definition was blocked because it + dependended on a definition with a failed + status. + + extra dependency This definition was added because it was + a dependency of a definition explicitly + selected. + +scratch/main> help-topic messages.disallowedAbsolute + + 🤖 + + Although I can understand absolute (ex: .foo.bar) or relative + (ex: util.math.sqrt) references to existing definitions + (help namespaces to learn more), I can't yet handle giving new + definitions with absolute names in a .u file. + + As a workaround, you can give definitions with a relative name + temporarily (like `exports.blah.foo`) and then use `move.*`. + +scratch/main> help-topic namespaces + + 🧐 + + There are two kinds of namespaces, absolute, such as (.foo.bar + or .base.math.+) and relative, such as (math.sqrt or + util.List.++). + + Relative names are converted to absolute names by prepending + the current namespace. For example, if your Unison prompt + reads: + + .foo.bar> + + and your .u file looks like: + + x = 41 + + then doing an add will create the definition with the absolute + name .foo.bar.x = 41 + + and you can refer to x by its absolute name .foo.bar.x + elsewhere in your code. For instance: + + answerToLifeTheUniverseAndEverything = .foo.bar.x + 1 + +scratch/main> help-topic projects + + A project is a versioned collection of code that can be + edited, published, and depended on other projects. Unison + projects are analogous to Git repositories. + + project.create create a new project + projects list all your projects + branch create a new workstream + branches list all your branches + merge merge one branch into another + switch switch to a project or branch + push upload your changes to Unison Share + pull download code(/changes/updates) from Unison Share + clone download a Unison Share project or branch for contribution + + Tip: Use `help project.create` to learn more. + + For full documentation, see + https://unison-lang.org/learn/projects + +scratch/main> help-topic remotes + + 🤖 + + Local projects may be associated with at most one remote + project on Unison Share. When this relationship is + established, it becomes the default argument for a number of + share commands. For example, running `push` or `pull` in a + project with no arguments will push to or pull from the + associated remote, if it exists. + + This association is created automatically on when a project is + created by `clone`. If the project was created locally then + the relationship will be established on the first `push`. + +scratch/main> help-topic testcache + + 🎈 + + Unison caches the results of test> watch expressions. Since + these expressions are pure and always yield the same result + when evaluated, there's no need to run them more than once! + + A test is rerun only if it has changed, or if one of the + definitions it depends on has changed. + +``` +We should add a command to show help for hidden commands also. + diff --git a/unison-src/transcripts/higher-rank.md b/unison-src/transcripts/higher-rank.md index 7fe63de504..bf9efcf678 100644 --- a/unison-src/transcripts/higher-rank.md +++ b/unison-src/transcripts/higher-rank.md @@ -2,9 +2,9 @@ This transcript does some testing of higher-rank types. Regression tests related to higher-rank types can be added here. ```ucm:hide -.> alias.type ##Nat Nat -.> alias.type ##Text Text -.> alias.type ##IO IO +scratch/main> alias.type ##Nat Nat +scratch/main> alias.type ##Text Text +scratch/main> alias.type ##IO IO ``` In this example, a higher-rank function is defined, `f`. No annotation is needed at the call-site of `f`, because the lambda is being checked against the polymorphic type `forall a . a -> a`, rather than inferred: @@ -19,8 +19,8 @@ f id = (id 1, id "hi") Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: ```unison -f : (forall a g . '{g} a -> '{g} a) -> () -> () -f id _ = +f : (forall a g . '{g} a -> '{g} a) -> () -> () +f id _ = _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) () ``` @@ -34,17 +34,17 @@ Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) Functor.map = cases Functor f -> f Functor.blah : Functor f -> () -Functor.blah = cases Functor f -> +Functor.blah = cases Functor f -> g : forall a b . (a -> b) -> f a -> f b g = f () ``` -This example is similar, but involves abilities: +This example is similar, but involves abilities: ```unison unique ability Remote t where doRemoteStuff : t () -unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) +unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) Loc.blah : Loc -> () Loc.blah = cases Loc f -> @@ -52,20 +52,20 @@ Loc.blah = cases Loc f -> f0 = f () --- In this case, no annotation is needed since the lambda +-- In this case, no annotation is needed since the lambda -- is checked against a polymorphic type -Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc Loc.transform nt = cases Loc f -> Loc (a -> f (nt a)) -- In this case, the annotation is needed since f' is inferred -- on its own it won't infer the higher-rank type -Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc -Loc.transform2 nt = cases Loc f -> +Loc.transform2 nt = cases Loc f -> f' : forall t a . '{Remote t} a ->{Remote t} t a f' a = f (nt a) - Loc f' + Loc f' ``` ## Types with polymorphic fields @@ -77,6 +77,6 @@ structural type HigherRanked = HigherRanked (forall a. a -> a) We should be able to add and view records with higher-rank fields. ```ucm -.higher_ranked> add -.higher_ranked> view HigherRanked +scratch/main> add +scratch/main> view HigherRanked ``` diff --git a/unison-src/transcripts/higher-rank.output.md b/unison-src/transcripts/higher-rank.output.md index a64a48ae39..449617d84f 100644 --- a/unison-src/transcripts/higher-rank.output.md +++ b/unison-src/transcripts/higher-rank.output.md @@ -1,16 +1,15 @@ - This transcript does some testing of higher-rank types. Regression tests related to higher-rank types can be added here. In this example, a higher-rank function is defined, `f`. No annotation is needed at the call-site of `f`, because the lambda is being checked against the polymorphic type `forall a . a -> a`, rather than inferred: -```unison +``` unison f : (forall a . a -> a) -> (Nat, Text) f id = (id 1, id "hi") > f (x -> x) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -32,14 +31,14 @@ f id = (id 1, id "hi") ``` Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: -```unison -f : (forall a g . '{g} a -> '{g} a) -> () -> () -f id _ = +``` unison +f : (forall a g . '{g} a -> '{g} a) -> () -> () +f id _ = _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -54,20 +53,20 @@ f id _ = ``` Here's an example, showing that polymorphic functions can be fields of a constructor, and the functions remain polymorphic even when the field is bound to a name during pattern matching: -```unison +``` unison unique type Functor f = Functor (forall a b . (a -> b) -> f a -> f b) Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) Functor.map = cases Functor f -> f Functor.blah : Functor f -> () -Functor.blah = cases Functor f -> +Functor.blah = cases Functor f -> g : forall a b . (a -> b) -> f a -> f b g = f () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -83,11 +82,11 @@ Functor.blah = cases Functor f -> -> (∀ a b. (a -> b) -> f a -> f b) ``` -This example is similar, but involves abilities: +This example is similar, but involves abilities: -```unison +``` unison unique ability Remote t where doRemoteStuff : t () -unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) +unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) Loc.blah : Loc -> () Loc.blah = cases Loc f -> @@ -95,23 +94,23 @@ Loc.blah = cases Loc f -> f0 = f () --- In this case, no annotation is needed since the lambda +-- In this case, no annotation is needed since the lambda -- is checked against a polymorphic type -Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc Loc.transform nt = cases Loc f -> Loc (a -> f (nt a)) -- In this case, the annotation is needed since f' is inferred -- on its own it won't infer the higher-rank type -Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc -Loc.transform2 nt = cases Loc f -> +Loc.transform2 nt = cases Loc f -> f' : forall t a . '{Remote t} a ->{Remote t} t a f' a = f (nt a) - Loc f' + Loc f' ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -134,22 +133,20 @@ Loc.transform2 nt = cases Loc f -> ``` ## Types with polymorphic fields -```unison +``` unison structural type HigherRanked = HigherRanked (forall a. a -> a) ``` We should be able to add and view records with higher-rank fields. -```ucm - ☝️ The namespace .higher_ranked is empty. - -.higher_ranked> add +``` ucm +scratch/main> add ⍟ I've added these definitions: structural type HigherRanked -.higher_ranked> view HigherRanked +scratch/main> view HigherRanked structural type HigherRanked = HigherRanked (∀ a. a -> a) diff --git a/unison-src/transcripts/input-parse-errors.md b/unison-src/transcripts/input-parse-errors.md new file mode 100644 index 0000000000..fe67a06cd9 --- /dev/null +++ b/unison-src/transcripts/input-parse-errors.md @@ -0,0 +1,173 @@ +# demonstrating our new input parsing errors + +```ucm:hide +scratch/main> builtins.merge lib.builtin +``` + +```unison:hide +x = 55 +``` +```ucm:hide +scratch/main> add +``` + +`handleNameArg` parse error in `add` +```ucm:error +scratch/main> add . +scratch/main> ls +scratch/main> add 1 +scratch/main> ls +scratch/main> add 2 +``` + +todo: +```haskell + SA.Name name -> pure name + SA.NameWithBranchPrefix (Left _) name -> pure name + SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname + SA.ShallowListEntry prefix entry -> + pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry + SA.SearchResult mpath result -> + maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result + otherNumArg -> Left . I.Formatted $ wrongStructuredArgument "a name" otherNumArg +``` + +aliasMany: skipped -- similar to `add` + +```ucm:error +scratch/main> update arg +``` + +aliasTerm +``` +scratch/main> alias.term ##Nat.+ Nat.+ +``` + +aliasTermForce, +aliasType, + + +todo: +``` + +aliasMany, +api, +authLogin, +back, +branchEmptyInputPattern, +branchInputPattern, +branchRenameInputPattern, +branchesInputPattern, +cd, +clear, +clone, +compileScheme, +createAuthor, +debugClearWatchCache, +debugDoctor, +debugDumpNamespace, +debugDumpNamespaceSimple, +debugTerm, +debugTermVerbose, +debugType, +debugLSPFoldRanges, +debugFileHashes, +debugNameDiff, +debugNumberedArgs, +debugTabCompletion, +debugFuzzyOptions, +debugFormat, +delete, +deleteBranch, +deleteProject, +deleteNamespace, +deleteNamespaceForce, +deleteTerm, +deleteTermVerbose, +deleteType, +deleteTypeVerbose, +deleteVerbose, +dependencies, +dependents, +diffNamespace, +display, +displayTo, +docToMarkdown, +docs, +docsToHtml, +edit, +editNamespace, +execute, +find, +findIn, +findAll, +findInAll, +findGlobal, +findShallow, +findVerbose, +findVerboseAll, +sfind, +sfindReplace, +forkLocal, +help, +helpTopics, +history, +ioTest, +ioTestAll, +libInstallInputPattern, +load, +makeStandalone, +mergeBuiltins, +mergeIOBuiltins, +mergeOldInputPattern, +mergeOldPreviewInputPattern, +mergeOldSquashInputPattern, +mergeInputPattern, +mergeCommitInputPattern, +names False, -- names +names True, -- names.global +namespaceDependencies, +previewAdd, +previewUpdate, +printVersion, +projectCreate, +projectCreateEmptyInputPattern, +projectRenameInputPattern, +projectSwitch, +projectsInputPattern, +pull, +pullWithoutHistory, +push, +pushCreate, +pushExhaustive, +pushForce, +quit, +releaseDraft, +renameBranch, +renameTerm, +renameType, +moveAll, +reset, +resetRoot, +runScheme, +saveExecuteResult, +test, +testAll, +todo, +ui, +undo, +up, +update, +updateBuiltins, +updateOld, +updateOldNoPatch, +upgrade, +upgradeCommitInputPattern, +view, +viewGlobal, +viewReflog +``` diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md new file mode 100644 index 0000000000..4dc0dc8133 --- /dev/null +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -0,0 +1,207 @@ +# demonstrating our new input parsing errors + +``` unison +x = 55 +``` + +`handleNameArg` parse error in `add` + +``` ucm +scratch/main> add . + +⚠️ + +Sorry, I wasn’t sure how to process your request: + + 1:2: + | + 1 | . + | ^ + unexpected end of input + expecting '`' or operator (valid characters: !$%&*+-/:<=>\^|~) + + +You can run `help add` for more information on using `add`. + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> add 1 + + + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> add 2 + + ⊡ Ignored previously added definitions: x + +``` +todo: + +``` haskell + SA.Name name -> pure name + SA.NameWithBranchPrefix (Left _) name -> pure name + SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname + SA.ShallowListEntry prefix entry -> + pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry + SA.SearchResult mpath result -> + maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result + otherNumArg -> Left . I.Formatted $ wrongStructuredArgument "a name" otherNumArg +``` + +aliasMany: skipped -- similar to `add` + +``` ucm +scratch/main> update arg + +⚠️ + +Sorry, I wasn’t sure how to process your request: + + I expected no arguments, but received one. + +You can run `help update` for more information on using +`update`. + +``` +aliasTerm + +``` +scratch/main> alias.term ##Nat.+ Nat.+ +``` + +aliasTermForce, +aliasType, + +todo: + +``` + +aliasMany, +api, +authLogin, +back, +branchEmptyInputPattern, +branchInputPattern, +branchRenameInputPattern, +branchesInputPattern, +cd, +clear, +clone, +compileScheme, +createAuthor, +debugClearWatchCache, +debugDoctor, +debugDumpNamespace, +debugDumpNamespaceSimple, +debugTerm, +debugTermVerbose, +debugType, +debugLSPFoldRanges, +debugFileHashes, +debugNameDiff, +debugNumberedArgs, +debugTabCompletion, +debugFuzzyOptions, +debugFormat, +delete, +deleteBranch, +deleteProject, +deleteNamespace, +deleteNamespaceForce, +deleteTerm, +deleteTermVerbose, +deleteType, +deleteTypeVerbose, +deleteVerbose, +dependencies, +dependents, +diffNamespace, +display, +displayTo, +docToMarkdown, +docs, +docsToHtml, +edit, +editNamespace, +execute, +find, +findIn, +findAll, +findInAll, +findGlobal, +findShallow, +findVerbose, +findVerboseAll, +sfind, +sfindReplace, +forkLocal, +help, +helpTopics, +history, +ioTest, +ioTestAll, +libInstallInputPattern, +load, +makeStandalone, +mergeBuiltins, +mergeIOBuiltins, +mergeOldInputPattern, +mergeOldPreviewInputPattern, +mergeOldSquashInputPattern, +mergeInputPattern, +mergeCommitInputPattern, +names False, -- names +names True, -- names.global +namespaceDependencies, +previewAdd, +previewUpdate, +printVersion, +projectCreate, +projectCreateEmptyInputPattern, +projectRenameInputPattern, +projectSwitch, +projectsInputPattern, +pull, +pullWithoutHistory, +push, +pushCreate, +pushExhaustive, +pushForce, +quit, +releaseDraft, +renameBranch, +renameTerm, +renameType, +moveAll, +reset, +resetRoot, +runScheme, +saveExecuteResult, +test, +testAll, +todo, +ui, +undo, +up, +update, +updateBuiltins, +updateOld, +updateOldNoPatch, +upgrade, +upgradeCommitInputPattern, +view, +viewGlobal, +viewReflog +``` + diff --git a/unison-src/transcripts/io-test-command.md b/unison-src/transcripts/io-test-command.md index 98d55a3da3..f10259137e 100644 --- a/unison-src/transcripts/io-test-command.md +++ b/unison-src/transcripts/io-test-command.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` The `io.test` command should run all of the tests within the current namespace, excluding libs. @@ -20,24 +20,24 @@ lib.ioAndExceptionTestInLib = do ``` ```ucm:hide -.> add +scratch/main> add ``` Run a IO tests one by one ```ucm -.> io.test ioAndExceptionTest -.> io.test ioTest +scratch/main> io.test ioAndExceptionTest +scratch/main> io.test ioTest ``` `io.test` doesn't cache results ```ucm -.> io.test ioAndExceptionTest +scratch/main> io.test ioAndExceptionTest ``` `io.test.all` will run all matching tests except those in the `lib` namespace. ```ucm -.> io.test.all +scratch/main> io.test.all ``` diff --git a/unison-src/transcripts/io-test-command.output.md b/unison-src/transcripts/io-test-command.output.md index 840d72b4f7..0e1d8cbbdc 100644 --- a/unison-src/transcripts/io-test-command.output.md +++ b/unison-src/transcripts/io-test-command.output.md @@ -1,6 +1,6 @@ The `io.test` command should run all of the tests within the current namespace, excluding libs. -```unison +``` unison -- We manually specify types so we don't need to pull in base to run IO and such ioAndExceptionTest : '{IO, Exception} [Result] ioAndExceptionTest = do @@ -15,48 +15,48 @@ lib.ioAndExceptionTestInLib = do [Ok "Success"] ``` -Run a IO tests one by one +Run a IO tests one by one -```ucm -.> io.test ioAndExceptionTest +``` ucm +scratch/main> io.test ioAndExceptionTest New test results: - ◉ ioAndExceptionTest Success + 1. ioAndExceptionTest ◉ Success ✅ 1 test(s) passing - Tip: Use view ioAndExceptionTest to view the source of a test. + Tip: Use view 1 to view the source of a test. -.> io.test ioTest +scratch/main> io.test ioTest New test results: - ◉ ioTest Success + 1. ioTest ◉ Success ✅ 1 test(s) passing - Tip: Use view ioTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `io.test` doesn't cache results -```ucm -.> io.test ioAndExceptionTest +``` ucm +scratch/main> io.test ioAndExceptionTest New test results: - ◉ ioAndExceptionTest Success + 1. ioAndExceptionTest ◉ Success ✅ 1 test(s) passing - Tip: Use view ioAndExceptionTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `io.test.all` will run all matching tests except those in the `lib` namespace. -```ucm -.> io.test.all +``` ucm +scratch/main> io.test.all @@ -68,11 +68,11 @@ Run a IO tests one by one New test results: - ◉ ioAndExceptionTest Success - ◉ ioTest Success + 1. ioAndExceptionTest ◉ Success + 2. ioTest ◉ Success ✅ 2 test(s) passing - Tip: Use view ioAndExceptionTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/io.md b/unison-src/transcripts/io.md index 4caedaef05..7db903ebb4 100644 --- a/unison-src/transcripts/io.md +++ b/unison-src/transcripts/io.md @@ -1,10 +1,10 @@ # tests for built-in IO functions ```ucm:hide -.> builtins.merge -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.merge +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` Tests for IO builtins which wired to foreign haskell calls. @@ -17,18 +17,19 @@ TempDirs/autoCleaned is an ability/hanlder which allows you to easily create a scratch directory which will automatically get cleaned up. ```ucm:hide -.> add +scratch/main> add ``` ## Basic File Functions ### Creating/Deleting/Renaming Directories -Tests: createDirectory, - isDirectory, - fileExists, - renameDirectory, - deleteDirectory +Tests: +- createDirectory, +- isDirectory, +- fileExists, +- renameDirectory, +- deleteDirectory ```unison testCreateRename : '{io2.IO} [Result] @@ -57,15 +58,16 @@ testCreateRename _ = ``` ```ucm -.> add -.> io.test testCreateRename +scratch/main> add +scratch/main> io.test testCreateRename ``` ### Opening / Closing files -Tests: openFile - closeFile - isFileOpen +Tests: +- openFile +- closeFile +- isFileOpen ```unison testOpenClose : '{io2.IO} [Result] @@ -107,16 +109,17 @@ testOpenClose _ = ``` ```ucm -.> add -.> io.test testOpenClose +scratch/main> add +scratch/main> io.test testOpenClose ``` ### Reading files with getSomeBytes -Tests: getSomeBytes - putBytes - isFileOpen - seekHandle +Tests: +- getSomeBytes +- putBytes +- isFileOpen +- seekHandle ```unison testGetSomeBytes : '{io2.IO} [Result] @@ -166,20 +169,21 @@ testGetSomeBytes _ = ``` ```ucm -.> add -.> io.test testGetSomeBytes +scratch/main> add +scratch/main> io.test testGetSomeBytes ``` ### Seeking in open files -Tests: openFile - putBytes - closeFile - isSeekable - isFileEOF - seekHandle - getBytes - getLine +Tests: +- openFile +- putBytes +- closeFile +- isSeekable +- isFileEOF +- seekHandle +- getBytes +- getLine ```unison testSeek : '{io2.IO} [Result] @@ -240,9 +244,9 @@ testAppend _ = ``` ```ucm -.> add -.> io.test testSeek -.> io.test testAppend +scratch/main> add +scratch/main> io.test testSeek +scratch/main> io.test testAppend ``` ### SystemTime @@ -257,8 +261,8 @@ testSystemTime _ = ``` ```ucm -.> add -.> io.test testSystemTime +scratch/main> add +scratch/main> io.test testSystemTime ``` ### Get temp directory @@ -274,8 +278,8 @@ testGetTempDirectory _ = ``` ```ucm -.> add -.> io.test testGetTempDirectory +scratch/main> add +scratch/main> io.test testGetTempDirectory ``` ### Get current directory @@ -291,8 +295,8 @@ testGetCurrentDirectory _ = ``` ```ucm -.> add -.> io.test testGetCurrentDirectory +scratch/main> add +scratch/main> io.test testGetCurrentDirectory ``` ### Get directory contents @@ -310,8 +314,8 @@ testDirContents _ = ``` ```ucm -.> add -.> io.test testDirContents +scratch/main> add +scratch/main> io.test testDirContents ``` ### Read environment variables @@ -328,8 +332,8 @@ testGetEnv _ = runTest test ``` ```ucm -.> add -.> io.test testGetEnv +scratch/main> add +scratch/main> io.test testGetEnv ``` ### Read command line args @@ -368,27 +372,27 @@ testGetArgs.runMeWithTwoArgs = 'let Test that they can be run with the right number of args. ```ucm -.> add -.> run runMeWithNoArgs -.> run runMeWithOneArg foo -.> run runMeWithTwoArgs foo bar +scratch/main> add +scratch/main> run runMeWithNoArgs +scratch/main> run runMeWithOneArg foo +scratch/main> run runMeWithTwoArgs foo bar ``` Calling our examples with the wrong number of args will error. ```ucm:error -.> run runMeWithNoArgs foo +scratch/main> run runMeWithNoArgs foo ``` ```ucm:error -.> run runMeWithOneArg +scratch/main> run runMeWithOneArg ``` ```ucm:error -.> run runMeWithOneArg foo bar +scratch/main> run runMeWithOneArg foo bar ``` ```ucm:error -.> run runMeWithTwoArgs +scratch/main> run runMeWithTwoArgs ``` ### Get the time zone @@ -401,8 +405,8 @@ testTimeZone = do ``` ```ucm -.> add -.> run testTimeZone +scratch/main> add +scratch/main> run testTimeZone ``` ### Get some random bytes @@ -417,6 +421,6 @@ testRandom = do ``` ```ucm -.> add -.> io.test testGetEnv +scratch/main> add +scratch/main> io.test testGetEnv ``` diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index 3a7d44d4db..4ac673c76e 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -13,13 +13,15 @@ create a scratch directory which will automatically get cleaned up. ### Creating/Deleting/Renaming Directories -Tests: createDirectory, - isDirectory, - fileExists, - renameDirectory, - deleteDirectory +Tests: -```unison + - createDirectory, + - isDirectory, + - fileExists, + - renameDirectory, + - deleteDirectory + +``` unison testCreateRename : '{io2.IO} [Result] testCreateRename _ = test = 'let @@ -45,7 +47,7 @@ testCreateRename _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,37 +60,39 @@ testCreateRename _ = testCreateRename : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testCreateRename : '{IO} [Result] -.> io.test testCreateRename +scratch/main> io.test testCreateRename New test results: - ◉ testCreateRename create a foo directory - ◉ testCreateRename directory should exist - ◉ testCreateRename foo should no longer exist - ◉ testCreateRename directory should no longer exist - ◉ testCreateRename bar should now exist - ◉ testCreateRename removeDirectory works recursively - ◉ testCreateRename removeDirectory works recursively + 1. testCreateRename ◉ create a foo directory + ◉ directory should exist + ◉ foo should no longer exist + ◉ directory should no longer exist + ◉ bar should now exist + ◉ removeDirectory works recursively + ◉ removeDirectory works recursively ✅ 7 test(s) passing - Tip: Use view testCreateRename to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Opening / Closing files -Tests: openFile - closeFile - isFileOpen +Tests: + + - openFile + - closeFile + - isFileOpen -```unison +``` unison testOpenClose : '{io2.IO} [Result] testOpenClose _ = test = 'let @@ -127,7 +131,7 @@ testOpenClose _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -140,37 +144,39 @@ testOpenClose _ = testOpenClose : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testOpenClose : '{IO} [Result] -.> io.test testOpenClose +scratch/main> io.test testOpenClose New test results: - ◉ testOpenClose file should be open - ◉ testOpenClose file handle buffering should match what we just set. - ◉ testOpenClose file should be closed - ◉ testOpenClose bytes have been written - ◉ testOpenClose bytes have been written - ◉ testOpenClose file should be closed + 1. testOpenClose ◉ file should be open + ◉ file handle buffering should match what we just set. + ◉ file should be closed + ◉ bytes have been written + ◉ bytes have been written + ◉ file should be closed ✅ 6 test(s) passing - Tip: Use view testOpenClose to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Reading files with getSomeBytes -Tests: getSomeBytes - putBytes - isFileOpen - seekHandle +Tests: + + - getSomeBytes + - putBytes + - isFileOpen + - seekHandle -```unison +``` unison testGetSomeBytes : '{io2.IO} [Result] testGetSomeBytes _ = test = 'let @@ -217,7 +223,7 @@ testGetSomeBytes _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -230,43 +236,45 @@ testGetSomeBytes _ = testGetSomeBytes : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testGetSomeBytes : '{IO} [Result] -.> io.test testGetSomeBytes +scratch/main> io.test testGetSomeBytes New test results: - ◉ testGetSomeBytes chunk size splits data into 2 uneven sides - ◉ testGetSomeBytes file should be closed - ◉ testGetSomeBytes first chunk matches first part of testData - ◉ testGetSomeBytes second chunk matches rest of testData - ◉ testGetSomeBytes should be at end of file - ◉ testGetSomeBytes reading at end of file results in Bytes.empty - ◉ testGetSomeBytes requesting many bytes results in what's available - ◉ testGetSomeBytes file should be closed + 1. testGetSomeBytes ◉ chunk size splits data into 2 uneven sides + ◉ file should be closed + ◉ first chunk matches first part of testData + ◉ second chunk matches rest of testData + ◉ should be at end of file + ◉ reading at end of file results in Bytes.empty + ◉ requesting many bytes results in what's available + ◉ file should be closed ✅ 8 test(s) passing - Tip: Use view testGetSomeBytes to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Seeking in open files -Tests: openFile - putBytes - closeFile - isSeekable - isFileEOF - seekHandle - getBytes - getLine +Tests: -```unison + - openFile + - putBytes + - closeFile + - isSeekable + - isFileEOF + - seekHandle + - getBytes + - getLine + +``` unison testSeek : '{io2.IO} [Result] testSeek _ = test = 'let @@ -324,7 +332,7 @@ testAppend _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -338,43 +346,44 @@ testAppend _ = testSeek : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testAppend : '{IO} [Result] testSeek : '{IO} [Result] -.> io.test testSeek +scratch/main> io.test testSeek New test results: - ◉ testSeek seeked - ◉ testSeek readable file should be seekable - ◉ testSeek shouldn't be the EOF - ◉ testSeek we should be at position 0 - ◉ testSeek we should be at position 1 - ◉ testSeek should be able to read our temporary file after seeking - ◉ testSeek getLine should get a line + 1. testSeek ◉ seeked + ◉ readable file should be seekable + ◉ shouldn't be the EOF + ◉ we should be at position 0 + ◉ we should be at position 1 + ◉ should be able to read our temporary file after seeking + ◉ getLine should get a line ✅ 7 test(s) passing - Tip: Use view testSeek to view the source of a test. + Tip: Use view 1 to view the source of a test. -.> io.test testAppend +scratch/main> io.test testAppend New test results: - ◉ testAppend should be able to read our temporary file + 1. testAppend ◉ should be able to read our temporary file ✅ 1 test(s) passing - Tip: Use view testAppend to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### SystemTime -```unison + +``` unison testSystemTime : '{io2.IO} [Result] testSystemTime _ = test = 'let @@ -384,7 +393,7 @@ testSystemTime _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -397,27 +406,27 @@ testSystemTime _ = testSystemTime : '{IO} [Result] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testSystemTime : '{IO} [Result] -.> io.test testSystemTime +scratch/main> io.test testSystemTime New test results: - ◉ testSystemTime systemTime should be sane + 1. testSystemTime ◉ systemTime should be sane ✅ 1 test(s) passing - Tip: Use view testSystemTime to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Get temp directory -```unison +``` unison testGetTempDirectory : '{io2.IO} [Result] testGetTempDirectory _ = test = 'let @@ -427,29 +436,28 @@ testGetTempDirectory _ = runTest test ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testGetTempDirectory : '{IO} [Result] -.> io.test testGetTempDirectory +scratch/main> io.test testGetTempDirectory New test results: - ◉ testGetTempDirectory Temp directory is directory - ◉ testGetTempDirectory Temp directory should exist + 1. testGetTempDirectory ◉ Temp directory is directory + ◉ Temp directory should exist ✅ 2 test(s) passing - Tip: Use view testGetTempDirectory to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` ### Get current directory -```unison +``` unison testGetCurrentDirectory : '{io2.IO} [Result] testGetCurrentDirectory _ = test = 'let @@ -459,29 +467,28 @@ testGetCurrentDirectory _ = runTest test ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testGetCurrentDirectory : '{IO} [Result] -.> io.test testGetCurrentDirectory +scratch/main> io.test testGetCurrentDirectory New test results: - ◉ testGetCurrentDirectory Current directory is directory - ◉ testGetCurrentDirectory Current directory should exist + 1. testGetCurrentDirectory ◉ Current directory is directory + ◉ Current directory should exist ✅ 2 test(s) passing - Tip: Use view testGetCurrentDirectory to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` ### Get directory contents -```unison +``` unison testDirContents : '{io2.IO} [Result] testDirContents _ = test = 'let @@ -493,28 +500,28 @@ testDirContents _ = runTest test ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testDirContents : '{IO} [Result] -.> io.test testDirContents +scratch/main> io.test testDirContents New test results: - ◉ testDirContents directory size should be - ◉ testDirContents directory contents should have current directory and parent + 1. testDirContents ◉ directory size should be + ◉ directory contents should have current directory and parent ✅ 2 test(s) passing - Tip: Use view testDirContents to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Read environment variables -```unison +``` unison testGetEnv : '{io2.IO} [Result] testGetEnv _ = test = 'let @@ -526,23 +533,23 @@ testGetEnv _ = runTest test ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testGetEnv : '{IO} [Result] -.> io.test testGetEnv +scratch/main> io.test testGetEnv New test results: - ◉ testGetEnv PATH environent variable should be set - ◉ testGetEnv DOESNTEXIST didn't exist + 1. testGetEnv ◉ PATH environent variable should be set + ◉ DOESNTEXIST didn't exist ✅ 2 test(s) passing - Tip: Use view testGetEnv to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Read command line args @@ -550,7 +557,7 @@ testGetEnv _ = `runMeWithNoArgs`, `runMeWithOneArg`, and `runMeWithTwoArgs` raise exceptions unless they called with the right number of arguments. -```unison +``` unison testGetArgs.fail : Text -> Failure testGetArgs.fail descr = Failure (typeLink IOFailure) descr !Any @@ -580,8 +587,9 @@ testGetArgs.runMeWithTwoArgs = 'let ``` Test that they can be run with the right number of args. -```ucm -.> add + +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -590,23 +598,23 @@ Test that they can be run with the right number of args. testGetArgs.runMeWithOneArg : '{IO, Exception} () testGetArgs.runMeWithTwoArgs : '{IO, Exception} () -.> run runMeWithNoArgs +scratch/main> run runMeWithNoArgs () -.> run runMeWithOneArg foo +scratch/main> run runMeWithOneArg foo () -.> run runMeWithTwoArgs foo bar +scratch/main> run runMeWithTwoArgs foo bar () ``` Calling our examples with the wrong number of args will error. -```ucm -.> run runMeWithNoArgs foo +``` ucm +scratch/main> run runMeWithNoArgs foo 💔💥 @@ -618,8 +626,8 @@ Calling our examples with the wrong number of args will error. ##raise ``` -```ucm -.> run runMeWithOneArg +``` ucm +scratch/main> run runMeWithOneArg 💔💥 @@ -631,8 +639,8 @@ Calling our examples with the wrong number of args will error. ##raise ``` -```ucm -.> run runMeWithOneArg foo bar +``` ucm +scratch/main> run runMeWithOneArg foo bar 💔💥 @@ -645,8 +653,8 @@ Calling our examples with the wrong number of args will error. ##raise ``` -```ucm -.> run runMeWithTwoArgs +``` ucm +scratch/main> run runMeWithTwoArgs 💔💥 @@ -660,28 +668,28 @@ Calling our examples with the wrong number of args will error. ``` ### Get the time zone -```unison +``` unison testTimeZone = do (offset, summer, name) = Clock.internals.systemTimeZone +0 _ = (offset : Int, summer : Nat, name : Text) () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testTimeZone : '{IO} () -.> run testTimeZone +scratch/main> run testTimeZone () ``` ### Get some random bytes -```unison +``` unison testRandom : '{io2.IO} [Result] testRandom = do test = do @@ -690,22 +698,22 @@ testRandom = do runTest test ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: testRandom : '{IO} [Result] -.> io.test testGetEnv +scratch/main> io.test testGetEnv New test results: - ◉ testGetEnv PATH environent variable should be set - ◉ testGetEnv DOESNTEXIST didn't exist + 1. testGetEnv ◉ PATH environent variable should be set + ◉ DOESNTEXIST didn't exist ✅ 2 test(s) passing - Tip: Use view testGetEnv to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/keyword-identifiers.output.md b/unison-src/transcripts/keyword-identifiers.output.md index 03ed3e919e..27a31d6f35 100644 --- a/unison-src/transcripts/keyword-identifiers.output.md +++ b/unison-src/transcripts/keyword-identifiers.output.md @@ -4,34 +4,34 @@ In particular, following a keyword with a `wordyIdChar` should be a valid identi Related issues: -- https://github.com/unisonweb/unison/issues/2091 -- https://github.com/unisonweb/unison/issues/2727 + - https://github.com/unisonweb/unison/issues/2091 + - https://github.com/unisonweb/unison/issues/2727 ## Keyword list Checks the following keywords: -- `type` -- `ability` -- `structural` -- `unique` -- `if` -- `then` -- `else` -- `forall` -- `handle` -- `with` -- `where` -- `use` -- `true` -- `false` -- `alias` -- `typeLink` -- `termLink` -- `let` -- `namespace` -- `match` -- `cases` + - `type` + - `ability` + - `structural` + - `unique` + - `if` + - `then` + - `else` + - `forall` + - `handle` + - `with` + - `where` + - `use` + - `true` + - `false` + - `alias` + - `typeLink` + - `termLink` + - `let` + - `namespace` + - `match` + - `cases` Note that although `∀` is a keyword, it cannot actually appear at the start of identifier. @@ -40,7 +40,7 @@ identifier. `type`: -```unison +``` unison typeFoo = 99 type1 = "I am a variable" type_ = 292 @@ -52,7 +52,7 @@ structural type type! type_ = type' type_ | type'' `ability`: -```unison +``` unison abilityFoo = 99 ability1 = "I am a variable" ability_ = 292 @@ -63,7 +63,7 @@ structural type ability! ability_ = ability' ability_ | ability'' `structural` -```unison +``` unison structuralFoo = 99 structural1 = "I am a variable" structural_ = 292 @@ -74,7 +74,7 @@ structural type structural! structural_ = structural' structural_ | structural'' `unique` -```unison +``` unison uniqueFoo = 99 unique1 = "I am a variable" unique_ = 292 @@ -85,7 +85,7 @@ structural type unique! unique_ = unique' unique_ | unique'' `if` -```unison +``` unison ifFoo = 99 if1 = "I am a variable" if_ = 292 @@ -96,7 +96,7 @@ structural type if! if_ = if' if_ | if'' `then` -```unison +``` unison thenFoo = 99 then1 = "I am a variable" then_ = 292 @@ -107,7 +107,7 @@ structural type then! then_ = then' then_ | then'' `else` -```unison +``` unison elseFoo = 99 else1 = "I am a variable" else_ = 292 @@ -118,7 +118,7 @@ structural type else! else_ = else' else_ | else'' `forall` -```unison +``` unison forallFoo = 99 forall1 = "I am a variable" forall_ = 292 @@ -129,7 +129,7 @@ structural type forall! forall_ = forall' forall_ | forall'' `handle` -```unison +``` unison handleFoo = 99 handle1 = "I am a variable" handle_ = 292 @@ -140,7 +140,7 @@ structural type handle! handle_ = handle' handle_ | handle'' `with` -```unison +``` unison withFoo = 99 with1 = "I am a variable" with_ = 292 @@ -151,7 +151,7 @@ structural type with! with_ = with' with_ | with'' `where` -```unison +``` unison whereFoo = 99 where1 = "I am a variable" where_ = 292 @@ -162,7 +162,7 @@ structural type where! where_ = where' where_ | where'' `use` -```unison +``` unison useFoo = 99 use1 = "I am a variable" use_ = 292 @@ -173,7 +173,7 @@ structural type use! use_ = use' use_ | use'' `true` -```unison +``` unison trueFoo = 99 true1 = "I am a variable" true_ = 292 @@ -184,7 +184,7 @@ structural type true! true_ = true' true_ | true'' `false` -```unison +``` unison falseFoo = 99 false1 = "I am a variable" false_ = 292 @@ -195,7 +195,7 @@ structural type false! false_ = false' false_ | false'' `alias` -```unison +``` unison aliasFoo = 99 alias1 = "I am a variable" alias_ = 292 @@ -206,7 +206,7 @@ structural type alias! alias_ = alias' alias_ | alias'' `typeLink` -```unison +``` unison typeLinkFoo = 99 typeLink1 = "I am a variable" typeLink_ = 292 @@ -217,7 +217,7 @@ structural type typeLink! typeLink_ = typeLink' typeLink_ | typeLink'' `termLink` -```unison +``` unison termLinkFoo = 99 termLink1 = "I am a variable" termLink_ = 292 @@ -228,7 +228,7 @@ structural type termLink! termLink_ = termLink' termLink_ | termLink'' `let` -```unison +``` unison letFoo = 99 let1 = "I am a variable" let_ = 292 @@ -239,7 +239,7 @@ structural type let! let_ = let' let_ | let'' `namespace` -```unison +``` unison namespaceFoo = 99 namespace1 = "I am a variable" namespace_ = 292 @@ -250,7 +250,7 @@ structural type namespace! namespace_ = namespace' namespace_ | namespace'' `match` -```unison +``` unison matchFoo = 99 match1 = "I am a variable" match_ = 292 @@ -261,7 +261,7 @@ structural type match! match_ = match' match_ | match'' `cases` -```unison +``` unison casesFoo = 99 cases1 = "I am a variable" cases_ = 292 diff --git a/unison-src/transcripts/kind-inference.md b/unison-src/transcripts/kind-inference.md index f81a3bf95c..3af86ae854 100644 --- a/unison-src/transcripts/kind-inference.md +++ b/unison-src/transcripts/kind-inference.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ## A type param cannot have conflicting kind constraints within a single decl diff --git a/unison-src/transcripts/kind-inference.output.md b/unison-src/transcripts/kind-inference.output.md index 73fb41d2d1..c40961bc71 100644 --- a/unison-src/transcripts/kind-inference.output.md +++ b/unison-src/transcripts/kind-inference.output.md @@ -1,12 +1,12 @@ - ## A type param cannot have conflicting kind constraints within a single decl conflicting constraints on the kind of `a` in a product -```unison + +``` unison unique type T a = T a (a Nat) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,13 +17,14 @@ unique type T a = T a (a Nat) ``` conflicting constraints on the kind of `a` in a sum -```unison + +``` unison unique type T a = Star a | StarStar (a Nat) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -37,12 +38,13 @@ unique type T a Successfully infer `a` in `Ping a` to be of kind `* -> *` by inspecting its component-mate `Pong`. -```unison + +``` unison unique type Ping a = Ping Pong unique type Pong = Pong (Ping Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,12 +60,13 @@ unique type Pong = Pong (Ping Optional) ``` Catch the conflict on the kind of `a` in `Ping a`. `Ping` restricts `a` to `*`, whereas `Pong` restricts `a` to `* -> *`. -```unison + +``` unison unique type Ping a = Ping a Pong unique type Pong = Pong (Ping Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -75,13 +78,14 @@ unique type Pong = Pong (Ping Optional) ``` Successful example between mutually recursive type and ability -```unison + +``` unison unique type Ping a = Ping (a Nat -> {Pong Nat} ()) unique ability Pong a where pong : Ping Optional -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -96,13 +100,14 @@ unique ability Pong a where ``` Catch conflict between mutually recursive type and ability -```unison + +``` unison unique type Ping a = Ping (a -> {Pong Nat} ()) unique ability Pong a where pong : Ping Optional -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -114,13 +119,14 @@ unique ability Pong a where ``` Consistent instantiation of `T`'s `a` parameter in `S` -```unison + +``` unison unique type T a = T a unique type S = S (T Nat) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -137,13 +143,14 @@ unique type S = S (T Nat) Delay kind defaulting until all components are processed. Here `S` constrains the kind of `T`'s `a` parameter, although `S` is not in the same component as `T`. -```unison + +``` unison unique type T a = T unique type S = S (T Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -158,13 +165,14 @@ unique type S = S (T Optional) ``` Catch invalid instantiation of `T`'s `a` parameter in `S` -```unison + +``` unison unique type T a = T a unique type S = S (T Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -178,12 +186,13 @@ unique type S = S (T Optional) ## Checking annotations Catch kind error in type annotation -```unison + +``` unison test : Nat Nat test = 0 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -195,12 +204,13 @@ test = 0 ``` Catch kind error in annotation example 2 -```unison + +``` unison test : Optional -> () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -212,14 +222,15 @@ test _ = () ``` Catch kind error in annotation example 3 -```unison + +``` unison unique type T a = T (a Nat) test : T Nat -> () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -231,7 +242,8 @@ test _ = () ``` Catch kind error in scoped type variable annotation -```unison + +``` unison unique type StarStar a = StarStar (a Nat) unique type Star a = Star a @@ -242,7 +254,7 @@ test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -256,7 +268,8 @@ test _ = ## Effect/type mismatch Effects appearing where types are expected -```unison + +``` unison unique ability Foo where foo : () @@ -264,7 +277,7 @@ test : Foo -> () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -276,12 +289,13 @@ test _ = () ``` Types appearing where effects are expected -```unison + +``` unison test : {Nat} () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -295,11 +309,11 @@ test _ = () ``` ## Cyclic kinds -```unison +``` unison unique type T a = T (a a) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -311,11 +325,11 @@ unique type T a = T (a a) is the kind of a. ``` -```unison +``` unison unique type T a b = T (a b) (b a) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -327,12 +341,12 @@ unique type T a b = T (a b) (b a) k = (k -> Type) -> Type where k is the kind of b. ``` -```unison +``` unison unique type Ping a = Ping (a Pong) unique type Pong a = Pong (a Ping) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/lambdacase.md b/unison-src/transcripts/lambdacase.md index e2e3a557ef..a4d1ba96f1 100644 --- a/unison-src/transcripts/lambdacase.md +++ b/unison-src/transcripts/lambdacase.md @@ -1,7 +1,7 @@ # Lambda case syntax ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This function takes a single argument and immediately pattern matches on it. As we'll see below, it can be written using `cases` syntax: @@ -13,7 +13,7 @@ isEmpty x = match x with ``` ```ucm:hide -.> add +scratch/main> add ``` Here's the same function written using `cases` syntax: @@ -27,7 +27,7 @@ isEmpty2 = cases Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` ```ucm -.> view isEmpty +scratch/main> view isEmpty ``` it shows the definition using `cases` syntax opportunistically, even though the code was originally written without that syntax. @@ -47,7 +47,7 @@ merge xs ys = match (xs, ys) with ``` ```ucm -.> add +scratch/main> add ``` And here's a version using `cases`. The patterns are separated by commas: @@ -65,7 +65,7 @@ merge2 = cases Notice that Unison detects this as an alias of `merge`, and if we view `merge` ```ucm -.> view merge +scratch/main> view merge ``` it again shows the definition using the multi-argument `cases` syntax opportunistically, even though the code was originally written without that syntax. @@ -101,8 +101,8 @@ merge3 = cases ``` ```ucm -.> add -.> view merge3 +scratch/main> add +scratch/main> view merge3 ``` This is the same definition written with multiple patterns and not using the `cases` syntax; notice it is considered an alias of `merge3` above. diff --git a/unison-src/transcripts/lambdacase.output.md b/unison-src/transcripts/lambdacase.output.md index efb41cdce8..c7c6e01c24 100644 --- a/unison-src/transcripts/lambdacase.output.md +++ b/unison-src/transcripts/lambdacase.output.md @@ -2,13 +2,13 @@ This function takes a single argument and immediately pattern matches on it. As we'll see below, it can be written using `cases` syntax: -```unison +``` unison isEmpty x = match x with [] -> true _ -> false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,13 +23,13 @@ isEmpty x = match x with ``` Here's the same function written using `cases` syntax: -```unison +``` unison isEmpty2 = cases [] -> true _ -> false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -45,8 +45,8 @@ isEmpty2 = cases ``` Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` -```ucm -.> view isEmpty +``` ucm +scratch/main> view isEmpty isEmpty : [t] -> Boolean isEmpty = cases @@ -60,7 +60,7 @@ it shows the definition using `cases` syntax opportunistically, even though the Functions that take multiple arguments and immediately match on a tuple of arguments can also be rewritten to use `cases`. Here's a version using regular `match` syntax on a tuple: -```unison +``` unison merge : [a] -> [a] -> [a] merge xs ys = match (xs, ys) with ([], ys) -> ys @@ -70,8 +70,8 @@ merge xs ys = match (xs, ys) with else h2 +: merge (h +: t) t2 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -80,7 +80,7 @@ merge xs ys = match (xs, ys) with ``` And here's a version using `cases`. The patterns are separated by commas: -```unison +``` unison merge2 : [a] -> [a] -> [a] merge2 = cases [], ys -> ys @@ -90,7 +90,7 @@ merge2 = cases else h2 +: merge2 (h +: t) t2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -106,8 +106,8 @@ merge2 = cases ``` Notice that Unison detects this as an alias of `merge`, and if we view `merge` -```ucm -.> view merge +``` ucm +scratch/main> view merge merge : [a] -> [a] -> [a] merge = cases @@ -122,7 +122,7 @@ it again shows the definition using the multi-argument `cases` syntax opportunis Here's another example: -```unison +``` unison structural type B = T | F blah : B -> B -> Text @@ -139,7 +139,7 @@ blorf = cases > blorf T F ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -171,7 +171,7 @@ blorf = cases ``` ## Patterns with multiple guards -```unison +``` unison merge3 : [a] -> [a] -> [a] merge3 = cases [], ys -> ys @@ -180,7 +180,7 @@ merge3 = cases | otherwise -> h2 +: merge3 (h +: t) t2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -193,14 +193,14 @@ merge3 = cases merge3 : [a] -> [a] -> [a] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: merge3 : [a] -> [a] -> [a] -.> view merge3 +scratch/main> view merge3 merge3 : [a] -> [a] -> [a] merge3 = cases @@ -213,7 +213,7 @@ merge3 = cases ``` This is the same definition written with multiple patterns and not using the `cases` syntax; notice it is considered an alias of `merge3` above. -```unison +``` unison merge4 : [a] -> [a] -> [a] merge4 a b = match (a,b) with [], ys -> ys @@ -222,7 +222,7 @@ merge4 a b = match (a,b) with h +: t, h2 +: t2 | otherwise -> h2 +: merge4 (h +: t) t2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/ls-pretty-print-scope-bug.md b/unison-src/transcripts/ls-pretty-print-scope-bug.md deleted file mode 100644 index a8d4cf5ed4..0000000000 --- a/unison-src/transcripts/ls-pretty-print-scope-bug.md +++ /dev/null @@ -1,44 +0,0 @@ -```unison -unique type Foo = Foo -``` - -```ucm -.a.b> add -.> fork .a.b .c.d.f -.c.g.f> -``` - -```unison -unique type Foo = Foo -``` - -```ucm -.c.g.f> add -.c> -``` - -```unison -foo = .d.f.Foo.Foo -``` - -```ucm -.c> add -``` - -At this point we have: -`.a.b.Foo` -`.c.d.f.Foo` which is equal to `.a.b.Foo` -`.c.g.f.Foo` which is distinct from the other `Foo` types - -```ucm -.> delete .c.d.f.Foo -``` -Once `.c.d.f.Foo` is deleted `.c.foo` should have the type `.a.b.Foo` -when viewed from `.>`, but an unnamed type when viewed from `.c>`, -since referencing `.a.b.Foo` would reference names outside of the -namespace rooted at `.c`. - -```ucm -.> ls c -.c> ls -``` diff --git a/unison-src/transcripts/ls-pretty-print-scope-bug.output.md b/unison-src/transcripts/ls-pretty-print-scope-bug.output.md deleted file mode 100644 index 567a176b64..0000000000 --- a/unison-src/transcripts/ls-pretty-print-scope-bug.output.md +++ /dev/null @@ -1,113 +0,0 @@ -```unison -unique type Foo = Foo -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - type Foo - -``` -```ucm - ☝️ The namespace .a.b is empty. - -.a.b> add - - ⍟ I've added these definitions: - - type Foo - -.> fork .a.b .c.d.f - - Done. - - ☝️ The namespace .c.g.f is empty. - -``` -```unison -unique type Foo = Foo -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - type Foo - -``` -```ucm -.c.g.f> add - - ⍟ I've added these definitions: - - type Foo - -``` -```unison -foo = .d.f.Foo.Foo -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - foo : d.f.Foo - -``` -```ucm -.c> add - - ⍟ I've added these definitions: - - foo : d.f.Foo - -``` -At this point we have: -`.a.b.Foo` -`.c.d.f.Foo` which is equal to `.a.b.Foo` -`.c.g.f.Foo` which is distinct from the other `Foo` types - -```ucm -.> delete .c.d.f.Foo - - Done. - -``` -Once `.c.d.f.Foo` is deleted `.c.foo` should have the type `.a.b.Foo` -when viewed from `.>`, but an unnamed type when viewed from `.c>`, -since referencing `.a.b.Foo` would reference names outside of the -namespace rooted at `.c`. - -```ucm -.> ls c - - 1. d/ (1 term) - 2. foo (b.Foo) - 3. g/ (1 term, 1 type) - -.c> ls - - 1. d/ (1 term) - 2. foo (#uj8oalgadr) - 3. g/ (1 term, 1 type) - -``` diff --git a/unison-src/transcripts/lsp-fold-ranges.md b/unison-src/transcripts/lsp-fold-ranges.md index 377c9170dd..20dddc3861 100644 --- a/unison-src/transcripts/lsp-fold-ranges.md +++ b/unison-src/transcripts/lsp-fold-ranges.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -29,5 +29,5 @@ test> z = let ``` ```ucm -.> debug.lsp.fold-ranges +scratch/main> debug.lsp.fold-ranges ``` diff --git a/unison-src/transcripts/lsp-fold-ranges.output.md b/unison-src/transcripts/lsp-fold-ranges.output.md index 51f8b4ae9e..46e0a9c76c 100644 --- a/unison-src/transcripts/lsp-fold-ranges.output.md +++ b/unison-src/transcripts/lsp-fold-ranges.output.md @@ -1,4 +1,4 @@ -```unison +``` unison {{ Type doc }} structural type Optional a = None @@ -23,8 +23,8 @@ test> z = let [Ok (x ++ y)] ``` -```ucm -.> debug.lsp.fold-ranges +``` ucm +scratch/main> debug.lsp.fold-ranges 《{{ Type doc }}》 《structural type Optional a = diff --git a/unison-src/transcripts/lsp-name-completion.md b/unison-src/transcripts/lsp-name-completion.md new file mode 100644 index 0000000000..ba879a72e9 --- /dev/null +++ b/unison-src/transcripts/lsp-name-completion.md @@ -0,0 +1,35 @@ +```ucm:hide +scratch/main> builtins.merge lib.builtins +``` + +```unison:hide +foldMap = "top-level" +nested.deeply.foldMap = "nested" +lib.base.foldMap = "lib" +lib.dep.lib.transitive.foldMap = "transitive-lib" +-- A deeply nested definition with the same hash as the top level one. +-- This should not be included in the completion results if a better name with the same hash IS included. +lib.dep.lib.transitive_same_hash.foldMap = "top-level" +foldMapWith = "partial match" + +other = "other" +``` + +```ucm:hide +scratch/main> add +``` + +Completion should find all the `foldMap` definitions in the codebase, +sorted by number of name segments, shortest first. + +Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or +prioritizing exact matches over partial matches. We don't have any control over that. + +```ucm +scratch/main> debug.lsp-name-completion foldMap +``` + +Should still find the term which has a matching hash to a better name if the better name doesn't match. +```ucm +scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap +``` diff --git a/unison-src/transcripts/lsp-name-completion.output.md b/unison-src/transcripts/lsp-name-completion.output.md new file mode 100644 index 0000000000..9c310ea871 --- /dev/null +++ b/unison-src/transcripts/lsp-name-completion.output.md @@ -0,0 +1,39 @@ +``` unison +foldMap = "top-level" +nested.deeply.foldMap = "nested" +lib.base.foldMap = "lib" +lib.dep.lib.transitive.foldMap = "transitive-lib" +-- A deeply nested definition with the same hash as the top level one. +-- This should not be included in the completion results if a better name with the same hash IS included. +lib.dep.lib.transitive_same_hash.foldMap = "top-level" +foldMapWith = "partial match" + +other = "other" +``` + +Completion should find all the `foldMap` definitions in the codebase, +sorted by number of name segments, shortest first. + +Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or +prioritizing exact matches over partial matches. We don't have any control over that. + +``` ucm +scratch/main> debug.lsp-name-completion foldMap + + Matching Path Name Hash + foldMap foldMap #o38ps8p4q6 + foldMapWith foldMapWith #r9rs4mcb0m + foldMap nested.deeply.foldMap #snrjegr5dk + foldMap lib.base.foldMap #jf4buul17k + foldMap lib.dep.lib.transitive.foldMap #0o01gvr3fi + +``` +Should still find the term which has a matching hash to a better name if the better name doesn't match. + +``` ucm +scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap + + Matching Path Name Hash + transitive_same_hash.foldMap lib.dep.lib.transitive_same_hash.foldMap #o38ps8p4q6 + +``` diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 9436ae5232..1d28320c84 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -3,9 +3,9 @@ The `merge` command merges together two branches in the same project: the current branch (unspecificed), and the target branch. For example, to merge `topic` into `main`, switch to `main` and run `merge topic`: -```ucm:error -.> help merge -.> help merge.commit +```ucm +scratch/main> help merge +scratch/main> help merge.commit ``` Let's see a simple unconflicted merge in action: Alice (us) and Bob (them) add different terms. The merged result @@ -48,7 +48,7 @@ project/alice> view foo bar ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Basic merge: two identical adds @@ -89,7 +89,7 @@ project/alice> view foo bar ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Simple update propagation @@ -142,7 +142,7 @@ project/alice> display bar ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Update propagation with common dependent @@ -208,7 +208,7 @@ project/alice> display foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Propagating an update to an update @@ -278,7 +278,7 @@ project/alice> display foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Update + delete isn't (currently) a conflict @@ -323,7 +323,7 @@ project/alice> view foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` In a future version, we'd like to give the user a warning at least. @@ -379,7 +379,7 @@ project/alice> view foo bar baz ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## No-op merge (Bob = Alice) @@ -397,7 +397,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## No-op merge (Bob < Alice) @@ -425,7 +425,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Fast-forward merge (Bob > Alice) @@ -453,7 +453,18 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project +``` + +## No-op merge: merge empty namespace into empty namespace + +```ucm +project/main> branch topic +project/main> merge /topic +``` + +```ucm:hide +scratch/main> project.delete project ``` ## Merge failure: someone deleted something @@ -498,7 +509,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: type error @@ -548,7 +559,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: simple term conflict @@ -613,7 +624,7 @@ project/merge-bob-into-alice> view bar baz ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: simple type conflict @@ -656,7 +667,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: type-update + constructor-rename conflict @@ -699,7 +710,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: constructor-rename conflict @@ -737,7 +748,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: non-constructor/constructor conflict @@ -778,7 +789,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: type/type conflict with term/constructor conflict @@ -829,7 +840,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` Here's a more involved example that demonstrates the same idea. @@ -902,7 +913,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge algorithm quirk: add/add unique types @@ -951,7 +962,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## `merge.commit` example (success) @@ -960,7 +971,6 @@ After merge conflicts are resolved, you can use `merge.commit` rather than `swit "commit" your changes. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio lib.builtins ``` @@ -1017,7 +1027,7 @@ project/alice> branches ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## `merge.commit` example (failure) @@ -1025,7 +1035,6 @@ project/alice> branches `merge.commit` can only be run on a "merge branch". ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio lib.builtins ``` @@ -1038,7 +1047,7 @@ project/topic> merge.commit ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` @@ -1097,7 +1106,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Conflict involving builtin @@ -1138,7 +1147,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Constructor alias @@ -1184,7 +1193,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Missing constructor name @@ -1231,7 +1240,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Nested decl alias @@ -1279,7 +1288,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Stray constructor alias @@ -1323,7 +1332,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Term or type in `lib` @@ -1364,7 +1373,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## LCA precondition violations @@ -1430,7 +1439,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Regression tests @@ -1475,7 +1484,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Delete a constructor @@ -1516,5 +1525,179 @@ project/main> view Foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project +``` + +### Dependent that doesn't need to be in the file + +This test demonstrates a bug. + + +```ucm:hide +project/alice> builtins.mergeio lib.builtins +``` + +In the LCA, we have `foo` with dependent `bar`, and `baz`. + +```unison +foo : Nat +foo = 17 + +bar : Nat +bar = foo + foo + +baz : Text +baz = "lca" +``` + +```ucm +project/alice> add +project/alice> branch bob +``` + +On Bob, we update `baz` to "bob". + +```unison +baz : Text +baz = "bob" +``` + +```ucm +project/bob> update +``` + +On Alice, we update `baz` to "alice" (conflict), but also update `foo` (unconflicted), which propagates to `bar`. + +```unison +foo : Nat +foo = 18 + +baz : Text +baz = "alice" +``` + +```ucm +project/alice> update +``` + +When we try to merge Bob into Alice, we should see both versions of `baz`, with Alice's unconflicted `foo` and `bar` in +the underlying namespace. + +```ucm:error +project/alice> merge /bob +``` + +But `bar` was put into the scratch file instead. + +```ucm:hide +scratch/main> project.delete project +``` + +### Merge loop test + +This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the +history. + +Let's make three identical namespaces with different histories: + +```unison +a = 1 +``` + +```ucm +project/alice> add +``` + +```unison +b = 2 +``` + +```ucm +project/alice> add +``` + +```unison +b = 2 +``` + +```ucm +project/bob> add +``` + +```unison +a = 1 +``` + +```ucm +project/bob> add +``` + +```unison +a = 1 +b = 2 +``` + +```ucm +project/carol> add +project/bob> merge /alice +project/carol> merge /bob +project/carol> history +``` + +```ucm:hide +scratch/main> project.delete project +``` + +### Variables named `_` + +This test demonstrates a change in syntactic hashing that fixed a bug due to auto-generated variable names for ignored +results. + +```ucm:hide +scratch/alice> builtins.mergeio lib.builtins +``` + +```unison +ignore : a -> () +ignore _ = () + +foo : Nat +foo = 18 + +bar : Nat +bar = + ignore "hi" + foo + foo +``` + +```ucm +scratch/alice> add +scratch/alice> branch bob +``` + +```unison +bar : Nat +bar = + ignore "hi" + foo + foo + foo +``` + +```ucm +scratch/bob> update +``` + +Previously, this update to `foo` would also cause a "real update" on `bar`, its dependent. Now it doesn't, so the merge +will succeed. + +```unison +foo : Nat +foo = 19 +``` + +```ucm +scratch/alice> update +``` + +```ucm +scratch/alice> merge /bob ``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 6334b362da..77350b1130 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -3,25 +3,25 @@ The `merge` command merges together two branches in the same project: the current branch (unspecificed), and the target branch. For example, to merge `topic` into `main`, switch to `main` and run `merge topic`: -```ucm -.> help merge +``` ucm +scratch/main> help merge -merge -`merge /branch` merges `branch` into the current branch + merge + `merge /branch` merges `branch` into the current branch -.> help merge.commit +scratch/main> help merge.commit -merge.commit (or commit.merge) -`merge.commit` merges a temporary branch created by the `merge` -command back into its parent branch, and removes the temporary -branch. - -For example, if you've done `merge topic` from main, then -`merge.commit` is equivalent to doing - - * switch /main - * merge /merge-topic-into-main - * delete.branch /merge-topic-into-main + merge.commit (or commit.merge) + `merge.commit` merges a temporary branch created by the + `merge` command back into its parent branch, and removes the + temporary branch. + + For example, if you've done `merge topic` from main, then + `merge.commit` is equivalent to doing + + * switch /main + * merge /merge-topic-into-main + * delete.branch /merge-topic-into-main ``` Let's see a simple unconflicted merge in action: Alice (us) and Bob (them) add different terms. The merged result @@ -30,19 +30,22 @@ contains both additions. ## Basic merge: two unconflicted adds Alice's adds: -```unison + +``` unison foo : Text foo = "alices foo" ``` Bob's adds: -```unison + +``` unison bar : Text bar = "bobs bar" ``` Merge result: -```ucm + +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -61,13 +64,15 @@ project/alice> view foo bar If Alice and Bob also happen to add the same definition, that's not a conflict. Alice's adds: -```unison + +``` unison foo : Text foo = "alice and bobs foo" ``` Bob's adds: -```unison + +``` unison foo : Text foo = "alice and bobs foo" @@ -76,7 +81,8 @@ bar = "bobs bar" ``` Merge result: -```ucm + +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -95,31 +101,35 @@ project/alice> view foo bar Updates that occur in one branch are propagated to the other. In this example, Alice updates `foo`, while Bob adds a new dependent `bar` of the original `foo`. When Bob's branch is merged into Alice's, her update to `foo` is propagated to his `bar`. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ``` Alice's updates: -```unison + +``` unison foo : Text foo = "new foo" ``` Bob's adds: -```unison + +``` unison bar : Text bar = foo ++ " - " ++ foo ``` -```ucm +``` ucm project/bob> display bar "old foo - old foo" ``` Merge result: -```ucm + +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -146,7 +156,8 @@ We classify something as an update if its "syntactic hash"—not its normal Unis Let's see an example. We have `foo`, which depends on `bar` and `baz`. Alice updates `bar` (propagating to `foo`), and Bob updates `baz` (propagating to `foo`). When we merge their updates, both updates will be reflected in the final `foo`. Original branch: -```unison + +``` unison foo : Text foo = "foo" ++ " - " ++ bar ++ " - " ++ baz @@ -158,31 +169,34 @@ baz = "old baz" ``` Alice's updates: -```unison + +``` unison bar : Text bar = "alices bar" ``` -```ucm +``` ucm project/alice> display foo "foo - alices bar - old baz" ``` Bob's updates: -```unison + +``` unison baz : Text baz = "bobs baz" ``` -```ucm +``` ucm project/bob> display foo "foo - old bar - bobs baz" ``` Merge result: -```ucm + +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -210,7 +224,8 @@ project/alice> display foo Of course, it's also possible for Alice's update to propagate to one of Bob's updates. In this example, `foo` depends on `bar` which depends on `baz`. Alice updates `baz`, propagating to `bar` and `foo`, while Bob updates `bar` (to something that still depends on `foo`), propagating to `baz`. The merged result will have Alice's update to `foo` incorporated into Bob's updated `bar`, and both updates will propagate to `baz`. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ++ " - " ++ bar @@ -221,38 +236,41 @@ baz : Text baz = "old baz" ``` -```ucm +``` ucm project/main> display foo "old foo - old bar - old baz" ``` Alice's updates: -```unison + +``` unison baz : Text baz = "alices baz" ``` -```ucm +``` ucm project/alice> display foo "old foo - old bar - alices baz" ``` Bob's updates: -```unison + +``` unison bar : Text bar = "bobs bar" ++ " - " ++ baz ``` -```ucm +``` ucm project/bob> display foo "old foo - bobs bar - old baz" ``` Merge result: -```ucm + +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -282,26 +300,30 @@ project/alice> display foo We don't currently consider "update + delete" a conflict like Git does. In this situation, the delete is just ignored, allowing the update to proceed. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ``` Alice's updates: -```unison + +``` unison foo : Text foo = "alices foo" ``` Bob's changes: -```ucm + +``` ucm project/bob> delete.term foo Done. ``` Merge result: -```ucm + +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -319,7 +341,8 @@ In a future version, we'd like to give the user a warning at least. Library dependencies don't cause merge conflicts, the library dependencies are just unioned together. If two library dependencies have the same name but different namespace hashes, then the merge algorithm makes up two fresh names. Alice's adds: -```unison + +``` unison lib.alice.foo : Nat lib.alice.foo = 17 @@ -331,7 +354,8 @@ lib.bothDifferent.baz = 19 ``` Bob's adds: -```unison + +``` unison lib.bob.foo : Nat lib.bob.foo = 20 @@ -343,7 +367,8 @@ lib.bothDifferent.baz = 21 ``` Merge result: -```ucm + +``` ucm project/alice> merge bob I merged project/bob into project/alice. @@ -370,7 +395,7 @@ project/alice> view foo bar baz If Bob is equals Alice, then merging Bob into Alice looks like this. -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -392,11 +417,11 @@ project/alice> merge /bob project/alice was already up-to-date with project/bob. ``` -## No-op merge (Bob < Alice) +## No-op merge (Bob \< Alice) If Bob is behind Alice, then merging Bob into Alice looks like this. -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -413,12 +438,13 @@ project/main> branch bob ``` Alice's addition: -```unison + +``` unison foo : Text foo = "foo" ``` -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -432,11 +458,11 @@ project/alice> merge /bob project/alice was already up-to-date with project/bob. ``` -## Fast-forward merge (Bob > Alice) +## Fast-forward merge (Bob \> Alice) If Bob is ahead of Alice, then merging Bob into Alice looks like this. -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -453,12 +479,13 @@ project/main> branch bob ``` Bob's addition: -```unison + +``` unison foo : Text foo = "foo" ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -469,6 +496,23 @@ project/alice> merge /bob I fast-forward merged project/bob into project/alice. +``` +## No-op merge: merge empty namespace into empty namespace + +``` ucm +project/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +project/main> merge /topic + + 😶 + + project/main was already up-to-date with project/topic. + ``` ## Merge failure: someone deleted something @@ -479,25 +523,28 @@ This can cause merge failures due to out-of-scope identifiers, and the user may In this example, Alice deletes `foo`, while Bob adds a new dependent of `foo`. Original branch: -```unison + +``` unison foo : Text foo = "foo" ``` Alice's delete: -```ucm + +``` ucm project/alice> delete.term foo Done. ``` Bob's new code that depends on `foo`: -```unison + +``` unison bar : Text bar = foo ++ " - " ++ foo ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -523,13 +570,12 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Text bar = use Text ++ foo ++ " - " ++ foo - ``` ## Merge failure: type error @@ -539,24 +585,27 @@ It may be Alice's and Bob's changes merge together cleanly in the sense that the In this example, Alice updates a `Text` to a `Nat`, while Bob adds a new dependent of the `Text`. Upon merging, propagating Alice's update to Bob's dependent causes a typechecking failure. Original branch: -```unison + +``` unison foo : Text foo = "foo" ``` Alice's update: -```unison + +``` unison foo : Nat foo = 100 ``` Bob's new definition: -```unison + +``` unison bar : Text bar = foo ++ " - " ++ foo ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -576,13 +625,12 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Text bar = use Text ++ foo ++ " - " ++ foo - ``` ## Merge failure: simple term conflict @@ -591,7 +639,8 @@ Alice and Bob may disagree about the definition of a term. In this case, the con are presented to the user to resolve. Original branch: -```unison + +``` unison foo : Text foo = "old foo" @@ -600,7 +649,8 @@ bar = "old bar" ``` Alice's changes: -```unison + +``` unison foo : Text foo = "alices foo" @@ -613,7 +663,7 @@ qux = "alices qux depends on alices foo" ++ foo Bob's changes: -```unison +``` unison foo : Text foo = "bobs foo" @@ -621,7 +671,7 @@ baz : Text baz = "bobs baz" ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -641,7 +691,7 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice foo : Text foo = "alices foo" @@ -658,10 +708,9 @@ qux = use Text ++ "alices qux depends on alices foo" ++ foo - ``` -```ucm +``` ucm project/merge-bob-into-alice> view bar baz bar : Text @@ -676,21 +725,24 @@ project/merge-bob-into-alice> view bar baz Ditto for types; if the hashes don't match, it's a conflict. In this example, Alice and Bob do different things to the same constructor. However, any explicit changes to the same type will result in a conflict, including changes that could concievably be merged (e.g. Alice and Bob both add a new constructor, or edit different constructors). Original branch: -```unison + +``` unison unique type Foo = MkFoo Nat ``` Alice's changes: -```unison + +``` unison unique type Foo = MkFoo Nat Nat ``` Bob's changes: -```unison + +``` unison unique type Foo = MkFoo Nat Text ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -710,14 +762,13 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = MkFoo Nat Nat -- project/bob type Foo = MkFoo Nat Text - ``` ## Merge failure: type-update + constructor-rename conflict @@ -725,21 +776,24 @@ type Foo = MkFoo Nat Text We model the renaming of a type's constructor as an update, so if Alice updates a type and Bob renames one of its constructors (even without changing its structure), we consider it a conflict. Original branch: -```unison + +``` unison unique type Foo = Baz Nat | Qux Text ``` Alice's changes `Baz Nat` to `Baz Nat Nat` -```unison + +``` unison unique type Foo = Baz Nat Nat | Qux Text ``` Bob's renames `Qux` to `BobQux`: -```unison + +``` unison unique type Foo = Baz Nat | BobQux Text ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -759,14 +813,13 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = Baz Nat Nat | Qux Text -- project/bob type Foo = Baz Nat | BobQux Text - ``` ## Merge failure: constructor-rename conflict @@ -774,25 +827,28 @@ type Foo = Baz Nat | BobQux Text Here is another example demonstrating that constructor renames are modeled as updates. Original branch: -```unison + +``` unison unique type Foo = Baz Nat | Qux Text ``` Alice's rename: -```ucm + +``` ucm project/alice> move.term Foo.Baz Foo.Alice Done. ``` Bob's rename: -```ucm + +``` ucm project/bob> move.term Foo.Qux Foo.Bob Done. ``` -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -812,14 +868,13 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = Qux Text | Alice Nat -- project/bob type Foo = Bob Text | Baz Nat - ``` ## Merge failure: non-constructor/constructor conflict @@ -827,18 +882,20 @@ type Foo = Bob Text | Baz Nat A constructor on one side can conflict with a regular term definition on the other. Alice's additions: -```unison + +``` unison my.cool.thing : Nat my.cool.thing = 17 ``` Bob's additions: -```unison + +``` unison unique ability my.cool where thing : Nat -> Nat ``` -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -858,7 +915,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice my.cool.thing : Nat my.cool.thing = 17 @@ -866,7 +923,6 @@ my.cool.thing = 17 -- project/bob ability my.cool where thing : Nat ->{cool} Nat - ``` ## Merge failure: type/type conflict with term/constructor conflict @@ -874,29 +930,33 @@ ability my.cool where thing : Nat ->{cool} Nat Here's a subtle situation where a new type is added on each side of the merge, and an existing term is replaced with a constructor of one of the types. Original branch: -```unison + +``` unison Foo.Bar : Nat Foo.Bar = 17 ``` Alice adds this type `Foo` with constructor `Foo.Alice`: -```unison + +``` unison unique type Foo = Alice Nat ``` Bob adds the type `Foo` with constructor `Foo.Bar`, replacing the original `Foo.Bar` term: -```ucm + +``` ucm project/bob> delete.term Foo.Bar Done. ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` These won't cleanly merge. -```ucm + +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -916,7 +976,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice Foo.Bar : Nat Foo.Bar = 17 @@ -927,14 +987,13 @@ type Foo = Alice Nat -- project/bob type Foo = Bar Nat Nat - ``` Here's a more involved example that demonstrates the same idea. In the LCA, we have a type with two constructors, and some term. -```unison +``` unison unique type Foo = Bar.Baz Nat | Bar.Qux Nat Nat @@ -945,7 +1004,7 @@ Foo.Bar.Hello = 17 Alice deletes this type entirely, and repurposes its constructor names for other terms. She also updates the term. -```ucm +``` ucm project/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello Foo.Bar.Baz : Nat @@ -960,7 +1019,7 @@ project/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello ``` Bob, meanwhile, first deletes the term, then sort of deletes the type and re-adds it under another name, but one constructor's fully qualified names doesn't actually change. The other constructor reuses the name of the deleted term. -```ucm +``` ucm project/bob> view Foo.Bar type Foo.Bar = Baz Nat | Hello Nat Nat @@ -970,7 +1029,7 @@ At this point, Bob and alice have both updated the name `Foo.Bar.Hello` in diffe Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she changed its hash and Bob didn't touch it) is nonetheless considered conflicted with Bob's "Foo.Bar.Baz". -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -990,7 +1049,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice Foo.Bar.Baz : Nat Foo.Bar.Baz = 100 @@ -1002,7 +1061,6 @@ Foo.Bar.Hello = 18 -- project/bob type Foo.Bar = Baz Nat | Hello Nat Nat - ``` ## Merge algorithm quirk: add/add unique types @@ -1014,7 +1072,8 @@ which is a parse error. We will resolve this situation automatically in a future version. Alice's additions: -```unison + +``` unison unique type Foo = Bar alice : Foo -> Nat @@ -1022,14 +1081,15 @@ alice _ = 18 ``` Bob's additions: -```unison + +``` unison unique type Foo = Bar bob : Foo -> Nat bob _ = 19 ``` -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -1049,7 +1109,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = Bar @@ -1067,7 +1127,6 @@ alice _ = 18 bob : Foo -> Nat bob _ = 19 - ``` ## `merge.commit` example (success) @@ -1076,27 +1135,29 @@ After merge conflicts are resolved, you can use `merge.commit` rather than `swit "commit" your changes. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ``` Alice's changes: -```unison + +``` unison foo : Text foo = "alices foo" ``` Bob's changes: -```unison +``` unison foo : Text foo = "bobs foo" ``` Attempt to merge: -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -1116,7 +1177,7 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice foo : Text foo = "alices foo" @@ -1125,17 +1186,16 @@ foo = "alices foo" foo : Text foo = "bobs foo" - ``` Resolve conflicts and commit: -```unison +``` unison foo : Text foo = "alice and bobs foo" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1148,7 +1208,7 @@ foo = "alice and bobs foo" foo : Text ``` -```ucm +``` ucm project/merge-bob-into-alice> update Okay, I'm searching the branch for code that needs to be @@ -1178,7 +1238,7 @@ project/alice> branches `merge.commit` can only be run on a "merge branch". -```ucm +``` ucm project/main> branch topic Done. I've created the topic branch based off of main. @@ -1187,7 +1247,7 @@ project/main> branch topic `switch /main` then `merge /topic`. ``` -```ucm +``` ucm project/topic> merge.commit It doesn't look like there's a merge in progress. @@ -1202,7 +1262,8 @@ There are a number of conditions under which we can't perform a merge, and the u If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). Original branch: -```unison + +``` unison foo : Nat foo = 100 @@ -1211,7 +1272,8 @@ bar = 100 ``` Alice's updates: -```unison + +``` unison foo : Nat foo = 200 @@ -1220,12 +1282,13 @@ bar = 300 ``` Bob's addition: -```unison + +``` unison baz : Text baz = "baz" ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1254,18 +1317,20 @@ conflict involving a builtin, we can't perform a merge. One way to fix this in the future would be to introduce a syntax for defining aliases in the scratch file. Alice's branch: -```ucm + +``` ucm project/alice> alias.type lib.builtins.Nat MyNat Done. ``` Bob's branch: -```unison + +``` unison unique type MyNat = MyNat Nat ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1284,23 +1349,25 @@ project/alice> merge /bob Each naming of a decl may not have more than one name for each constructor, within the decl's namespace. Alice's branch: -```unison + +``` unison unique type Foo = Bar ``` -```ucm +``` ucm project/alice> alias.term Foo.Bar Foo.some.other.Alias Done. ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1320,23 +1387,25 @@ project/alice> merge /bob Each naming of a decl must have a name for each constructor, within the decl's namespace. Alice's branch: -```unison + +``` unison unique type Foo = Bar ``` -```ucm +``` ucm project/alice> delete.term Foo.Bar Done. ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1354,12 +1423,13 @@ project/alice> merge /bob A decl cannot be aliased within the namespace of another of its aliased. Alice's branch: -```unison + +``` unison structural type A = B Nat | C Nat Nat structural type A.inner.X = Y Nat | Z Nat Nat ``` -```ucm +``` ucm project/alice> names A Type @@ -1370,12 +1440,13 @@ project/alice> names A ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob On project/alice, the type A.inner.X is an alias of A. I'm not @@ -1389,7 +1460,8 @@ project/alice> merge /bob Constructors may only exist within the corresponding decl's namespace. Alice's branch: -```ucm + +``` ucm project/alice> add ⍟ I've added these definitions: @@ -1402,7 +1474,8 @@ project/alice> alias.term Foo.Bar AliasOutsideFooNamespace ``` Bob's branch: -```ucm + +``` ucm project/bob> add ⍟ I've added these definitions: @@ -1410,7 +1483,7 @@ project/bob> add bob : Nat ``` -```ucm +``` ucm project/alice> merge bob Sorry, I wasn't able to perform the merge, because I need all @@ -1428,18 +1501,20 @@ project/alice> merge bob By convention, `lib` can only namespaces; each of these represents a library dependencies. Individual terms and types are not allowed at the top level of `lib`. Alice's branch: -```unison + +``` unison lib.foo : Nat lib.foo = 1 ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1453,18 +1528,18 @@ project/alice> merge /bob ``` ## LCA precondition violations -The LCA is not subject to most precondition violations, which is good, because the user can't easily manipulate it! +The LCA is not subject to most precondition violations, which is good, because the user can't easily manipulate it\! Here's an example. We'll delete a constructor name from the LCA and still be able to merge Alice and Bob's stuff together. LCA: -```unison +``` unison structural type Foo = Bar Nat | Baz Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1477,7 +1552,7 @@ structural type Foo = Bar Nat | Baz Nat Nat structural type Foo ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -1491,7 +1566,7 @@ project/main> delete.term Foo.Baz ``` Alice's branch: -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -1508,12 +1583,12 @@ project/alice> delete.term Foo.Bar Done. ``` -```unison +``` unison alice : Nat alice = 100 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1526,7 +1601,7 @@ alice = 100 alice : Nat ``` -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -1536,7 +1611,7 @@ project/alice> add ``` Bob's branch: -```ucm +``` ucm project/main> branch bob Done. I've created the bob branch based off of main. @@ -1553,12 +1628,12 @@ project/bob> delete.term Foo.Bar Done. ``` -```unison +``` unison bob : Nat bob = 101 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1571,7 +1646,7 @@ bob = 101 bob : Nat ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -1581,7 +1656,7 @@ project/bob> add ``` Now we merge: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -1591,13 +1666,12 @@ project/alice> merge /bob ### Delete one alias and update the other - -```unison +``` unison foo = 17 bar = 17 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1611,7 +1685,7 @@ bar = 17 foo : Nat ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -1631,11 +1705,11 @@ project/alice> delete.term bar Done. ``` -```unison +``` unison foo = 18 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1649,7 +1723,7 @@ foo = 18 foo : Nat ``` -```ucm +``` ucm project/alice> update Okay, I'm searching the branch for code that needs to be @@ -1665,11 +1739,11 @@ project/main> branch bob `switch /main` then `merge /bob`. ``` -```unison +``` unison bob = 101 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1682,7 +1756,7 @@ bob = 101 bob : Nat ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -1690,7 +1764,7 @@ project/bob> add bob : Nat ``` -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -1698,12 +1772,11 @@ project/alice> merge /bob ``` ### Delete a constructor - -```unison +``` unison type Foo = Bar | Baz ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1716,7 +1789,7 @@ type Foo = Bar | Baz type Foo ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -1731,11 +1804,11 @@ project/main> branch topic `switch /main` then `merge /topic`. ``` -```unison +``` unison boop = "boop" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1748,7 +1821,7 @@ boop = "boop" boop : Text ``` -```ucm +``` ucm project/topic> add ⍟ I've added these definitions: @@ -1756,11 +1829,11 @@ project/topic> add boop : Text ``` -```unison +``` unison type Foo = Bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1774,7 +1847,7 @@ type Foo = Bar type Foo ``` -```ucm +``` ucm project/main> update Okay, I'm searching the branch for code that needs to be @@ -1783,7 +1856,7 @@ project/main> update Done. ``` -```ucm +``` ucm project/main> merge topic I merged project/topic into project/main. @@ -1793,3 +1866,433 @@ project/main> view Foo type Foo = Bar ``` +### Dependent that doesn't need to be in the file + +This test demonstrates a bug. + +In the LCA, we have `foo` with dependent `bar`, and `baz`. + +``` unison +foo : Nat +foo = 17 + +bar : Nat +bar = foo + foo + +baz : Text +baz = "lca" +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + baz : Text + foo : Nat + +``` +``` ucm +project/alice> add + + ⍟ I've added these definitions: + + bar : Nat + baz : Text + foo : Nat + +project/alice> branch bob + + Done. I've created the bob branch based off of alice. + + Tip: To merge your work back into the alice branch, first + `switch /alice` then `merge /bob`. + +``` +On Bob, we update `baz` to "bob". + +``` unison +baz : Text +baz = "bob" +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + baz : Text + +``` +``` ucm +project/bob> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +``` +On Alice, we update `baz` to "alice" (conflict), but also update `foo` (unconflicted), which propagates to `bar`. + +``` unison +foo : Nat +foo = 18 + +baz : Text +baz = "alice" +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + baz : Text + foo : Nat + +``` +``` ucm +project/alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +``` +When we try to merge Bob into Alice, we should see both versions of `baz`, with Alice's unconflicted `foo` and `bar` in +the underlying namespace. + +``` ucm +project/alice> merge /bob + + I couldn't automatically merge project/bob into project/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + + When you're done, you can run + + merge.commit + + to merge your changes back into alice and delete the temporary + branch. Or, if you decide to cancel the merge instead, you can + run + + delete.branch /merge-bob-into-alice + + to delete the temporary branch and switch back to alice. + +``` +``` unison:added-by-ucm scratch.u +-- project/alice +baz : Text +baz = "alice" + +-- project/bob +baz : Text +baz = "bob" + +-- The definitions below are not conflicted, but they each depend on one or more +-- conflicted definitions above. + +bar : Nat +bar = + use Nat + + foo + foo + +``` + +But `bar` was put into the scratch file instead. + +### Merge loop test + +This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the +history. + +Let's make three identical namespaces with different histories: + +``` unison +a = 1 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + a : ##Nat + +``` +``` ucm +project/alice> add + + ⍟ I've added these definitions: + + a : ##Nat + +``` +``` unison +b = 2 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + b : ##Nat + +``` +``` ucm +project/alice> add + + ⍟ I've added these definitions: + + b : ##Nat + +``` +``` unison +b = 2 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +``` ucm +project/bob> add + + ⍟ I've added these definitions: + + b : ##Nat + +``` +``` unison +a = 1 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + a : ##Nat + +``` +``` ucm +project/bob> add + + ⍟ I've added these definitions: + + a : ##Nat + +``` +``` unison +a = 1 +b = 2 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +``` ucm +project/carol> add + + ⍟ I've added these definitions: + + a : ##Nat + b : ##Nat + +project/bob> merge /alice + + I merged project/alice into project/bob. + +project/carol> merge /bob + + I merged project/bob into project/carol. + +project/carol> history + + Note: The most recent namespace hash is immediately below this + message. + + + + This segment of history starts with a merge. Use + `history #som3n4m3space` to view history starting from a given + namespace hash. + + ⊙ 1. #b7fr6ifj87 + ⑃ + 2. #9npggauqo9 + 3. #dm4u1eokg1 + +``` +### Variables named `_` + +This test demonstrates a change in syntactic hashing that fixed a bug due to auto-generated variable names for ignored +results. + +``` unison +ignore : a -> () +ignore _ = () + +foo : Nat +foo = 18 + +bar : Nat +bar = + ignore "hi" + foo + foo +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat + ignore : a -> () + +``` +``` ucm +scratch/alice> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + ignore : a -> () + +scratch/alice> branch bob + + Done. I've created the bob branch based off of alice. + + Tip: To merge your work back into the alice branch, first + `switch /alice` then `merge /bob`. + +``` +``` unison +bar : Nat +bar = + ignore "hi" + foo + foo + foo +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + bar : Nat + +``` +``` ucm +scratch/bob> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +``` +Previously, this update to `foo` would also cause a "real update" on `bar`, its dependent. Now it doesn't, so the merge +will succeed. + +``` unison +foo : Nat +foo = 19 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + foo : Nat + +``` +``` ucm +scratch/alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +``` +``` ucm +scratch/alice> merge /bob + + I merged scratch/bob into scratch/alice. + +``` diff --git a/unison-src/transcripts/mergeloop.md b/unison-src/transcripts/mergeloop.md deleted file mode 100644 index fd1b25fa8e..0000000000 --- a/unison-src/transcripts/mergeloop.md +++ /dev/null @@ -1,51 +0,0 @@ -# Merge loop test - -This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the history. - -Let's make three identical namespaces with different histories: - -```unison -a = 1 -``` - -```ucm -.x> add -``` - -```unison -b = 2 -``` - -```ucm -.x> add -``` - -```unison -b = 2 -``` - -```ucm -.y> add -``` - -```unison -a = 1 -``` - -```ucm -.y> add -``` - -```unison -a = 1 -b = 2 -``` - -```ucm -.z> add -.> merge.old x y -.> merge.old y z -.> history z -``` - - diff --git a/unison-src/transcripts/mergeloop.output.md b/unison-src/transcripts/mergeloop.output.md deleted file mode 100644 index faa084764b..0000000000 --- a/unison-src/transcripts/mergeloop.output.md +++ /dev/null @@ -1,157 +0,0 @@ -# Merge loop test - -This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the history. - -Let's make three identical namespaces with different histories: - -```unison -a = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - a : ##Nat - -``` -```ucm - ☝️ The namespace .x is empty. - -.x> add - - ⍟ I've added these definitions: - - a : ##Nat - -``` -```unison -b = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - b : ##Nat - -``` -```ucm -.x> add - - ⍟ I've added these definitions: - - b : ##Nat - -``` -```unison -b = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -```ucm - ☝️ The namespace .y is empty. - -.y> add - - ⍟ I've added these definitions: - - b : ##Nat - -``` -```unison -a = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - a : ##Nat - -``` -```ucm -.y> add - - ⍟ I've added these definitions: - - a : ##Nat - -``` -```unison -a = 1 -b = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -```ucm - ☝️ The namespace .z is empty. - -.z> add - - ⍟ I've added these definitions: - - a : ##Nat - b : ##Nat - -.> merge.old x y - - Nothing changed as a result of the merge. - - Applying changes from patch... - -.> merge.old y z - - Nothing changed as a result of the merge. - - Applying changes from patch... - -.> history z - - Note: The most recent namespace hash is immediately below this - message. - - - - This segment of history starts with a merge. Use - `history #som3n4m3space` to view history starting from a given - namespace hash. - - ⊙ 1. #b7fr6ifj87 - ⑃ - 2. #9npggauqo9 - 3. #dm4u1eokg1 - -``` diff --git a/unison-src/transcripts/merges.md b/unison-src/transcripts/merges.md deleted file mode 100644 index 330e46857b..0000000000 --- a/unison-src/transcripts/merges.md +++ /dev/null @@ -1,121 +0,0 @@ -# Forking and merging namespaces in `ucm` - -```ucm:hide -.master> builtins.merge -``` - -The Unison namespace is a versioned tree of names that map to Unison definitions. You can change this namespace and fork and merge subtrees of it. Let's start by introducing a few definitions into a new namespace, `foo`: - -```unison -x = 42 -``` - -```ucm -.> add -``` - -Let's move `x` into a new namespace, `master`: - -```ucm -.> rename.term x master.x -``` - -If you want to do some experimental work in a namespace without disturbing anyone else, you can `fork` it (which is a shorthand for `copy.namespace`). This creates a copy of it, preserving its history. - -> __Note:__ these copies are very efficient to create as they just have pointers into the same underlying definitions. Create as many as you like. - -Let's go ahead and do this: - -``` -.> fork master feature1 -.> view master.x -.> view feature1.x -``` - -Great! We can now do some further work in the `feature1` branch, then merge it back into `master` when we're ready. - -```unison -y = "hello" -``` - -```ucm -.feature1> add -.master> merge.old .feature1 -.master> view y -``` - -> Note: `merge src`, with one argument, merges `src` into the current namespace. You can also do `merge src dest` to merge into any destination namespace. - -Notice that `master` now has the definition of `y` we wrote. - -We can also delete the fork if we're done with it. (Don't worry, even though the history at that path is now empty, -it's still in the `history` of the parent namespace and can be resurrected at any time.) - -```ucm -.> delete.namespace feature1 -.> history .feature1 -.> history -``` - -To resurrect an old version of a namespace, you can learn its hash via the `history` command, then use `fork #namespacehash .newname`. - -## Concurrent edits and merges - -In the above scenario the destination namespace (`master`) was strictly behind the source namespace, so the merge didn't have anything interesting to do (Git would call this a "fast forward" merge). In other cases, the source and destination namespaces will each have changes the other doesn't know about, and the merge needs to something more interesting. That's okay too, and Unison will merge those results, using a 3-way merge algorithm. - -> __Note:__ When merging nested namespaces, Unison actually uses a recursive 3-way merge, so it finds a different (and possibly closer) common ancestor at each level of the tree. - -Let's see how this works. We are going to create a copy of `master`, add and delete some definitions in `master` and in the fork, then merge. - -```ucm -.> fork master feature2 -``` - -Here's one fork, we add `z` and delete `x`: - -```unison -z = 99 -``` - -```ucm -.feature2> add -.feature2> delete.term.verbose x -``` - -And here's the other fork, where we update `y` and add a new definition, `frobnicate`: - -```unison -master.y = "updated y" -master.frobnicate n = n + 1 -``` - -```ucm -.> update -.> view master.y -.> view master.frobnicate -``` - -At this point, `master` and `feature2` both have some changes the other doesn't know about. Let's merge them. - -```ucm -.> merge.old feature2 master -``` - -Notice that `x` is deleted in the merged branch (it was deleted in `feature2` and untouched by `master`): - -```ucm:error -.> view master.x -``` - -And notice that `y` has the most recent value, and that `z` and `frobnicate` both exist as well: - -```ucm -.> view master.y -.> view master.z -.> view master.frobnicate -``` - -## FAQ - -* What happens if namespace1 deletes a name that namespace2 has updated? A: ??? -* ... diff --git a/unison-src/transcripts/merges.output.md b/unison-src/transcripts/merges.output.md deleted file mode 100644 index 8bfbb170fb..0000000000 --- a/unison-src/transcripts/merges.output.md +++ /dev/null @@ -1,312 +0,0 @@ -# Forking and merging namespaces in `ucm` - -The Unison namespace is a versioned tree of names that map to Unison definitions. You can change this namespace and fork and merge subtrees of it. Let's start by introducing a few definitions into a new namespace, `foo`: - -```unison -x = 42 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - x : Nat - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - x : Nat - -``` -Let's move `x` into a new namespace, `master`: - -```ucm -.> rename.term x master.x - - Done. - -``` -If you want to do some experimental work in a namespace without disturbing anyone else, you can `fork` it (which is a shorthand for `copy.namespace`). This creates a copy of it, preserving its history. - -> __Note:__ these copies are very efficient to create as they just have pointers into the same underlying definitions. Create as many as you like. - -Let's go ahead and do this: - -``` -.> fork master feature1 -.> view master.x -.> view feature1.x - -``` - -Great! We can now do some further work in the `feature1` branch, then merge it back into `master` when we're ready. - -```unison -y = "hello" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y : Text - -``` -```ucm - ☝️ The namespace .feature1 is empty. - -.feature1> add - - ⍟ I've added these definitions: - - y : ##Text - -.master> merge.old .feature1 - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. y : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.master> view y - - y : Text - y = "hello" - -``` -> Note: `merge src`, with one argument, merges `src` into the current namespace. You can also do `merge src dest` to merge into any destination namespace. - -Notice that `master` now has the definition of `y` we wrote. - -We can also delete the fork if we're done with it. (Don't worry, even though the history at that path is now empty, -it's still in the `history` of the parent namespace and can be resurrected at any time.) - -```ucm -.> delete.namespace feature1 - - Done. - -.> history .feature1 - - ☝️ The namespace .feature1 is empty. - -.> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #6j9omad7mv - - - Deletes: - - feature1.y - - ⊙ 2. #59u4sdgodu - - + Adds / updates: - - master.y - - = Copies: - - Original name New name(s) - feature1.y master.y - - ⊙ 3. #0je96at36h - - + Adds / updates: - - feature1.y - - ⊙ 4. #cnv4gjntbl - - > Moves: - - Original name New name - x master.x - - ⊙ 5. #tp0bn8ulih - - + Adds / updates: - - x - - □ 6. #cujaete914 (start of history) - -``` -To resurrect an old version of a namespace, you can learn its hash via the `history` command, then use `fork #namespacehash .newname`. - -## Concurrent edits and merges - -In the above scenario the destination namespace (`master`) was strictly behind the source namespace, so the merge didn't have anything interesting to do (Git would call this a "fast forward" merge). In other cases, the source and destination namespaces will each have changes the other doesn't know about, and the merge needs to something more interesting. That's okay too, and Unison will merge those results, using a 3-way merge algorithm. - -> __Note:__ When merging nested namespaces, Unison actually uses a recursive 3-way merge, so it finds a different (and possibly closer) common ancestor at each level of the tree. - -Let's see how this works. We are going to create a copy of `master`, add and delete some definitions in `master` and in the fork, then merge. - -```ucm -.> fork master feature2 - - Done. - -``` -Here's one fork, we add `z` and delete `x`: - -```unison -z = 99 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - z : Nat - -``` -```ucm -.feature2> add - - ⍟ I've added these definitions: - - z : Nat - -.feature2> delete.term.verbose x - - Removed definitions: - - 1. x : Nat - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -And here's the other fork, where we update `y` and add a new definition, `frobnicate`: - -```unison -master.y = "updated y" -master.frobnicate n = n + 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - master.frobnicate : Nat -> Nat - master.y : Text - -``` -```ucm -.> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -.> view master.y - - master.y : Text - master.y = "updated y" - -.> view master.frobnicate - - master.frobnicate : Nat -> Nat - master.frobnicate n = - use Nat + - n + 1 - -``` -At this point, `master` and `feature2` both have some changes the other doesn't know about. Let's merge them. - -```ucm -.> merge.old feature2 master - - Here's what's changed in master after the merge: - - Added definitions: - - 1. z : Nat - - Removed definitions: - - 2. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -Notice that `x` is deleted in the merged branch (it was deleted in `feature2` and untouched by `master`): - -```ucm -.> view master.x - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - master.x - -``` -And notice that `y` has the most recent value, and that `z` and `frobnicate` both exist as well: - -```ucm -.> view master.y - - master.y : Text - master.y = "updated y" - -.> view master.z - - master.z : Nat - master.z = 99 - -.> view master.frobnicate - - master.frobnicate : Nat -> Nat - master.frobnicate n = - use Nat + - n + 1 - -``` -## FAQ - -* What happens if namespace1 deletes a name that namespace2 has updated? A: ??? -* ... diff --git a/unison-src/transcripts/move-all.md b/unison-src/transcripts/move-all.md index f3a4f5209c..ee83aa33a7 100644 --- a/unison-src/transcripts/move-all.md +++ b/unison-src/transcripts/move-all.md @@ -1,7 +1,7 @@ # Tests for `move` ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ## Happy Path - namespace, term, and type @@ -16,7 +16,7 @@ unique type Foo.T = T ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -25,16 +25,16 @@ unique type Foo.T = T1 | T2 ``` ```ucm -.> update +scratch/main> update ``` Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. ```ucm -.> move Foo Bar -.> ls -.> ls Bar -.> history Bar +scratch/main> move Foo Bar +scratch/main> ls +scratch/main> ls Bar +scratch/main> history Bar ``` ## Happy Path - Just term @@ -44,10 +44,10 @@ bonk = 5 ``` ```ucm -.z> builtins.merge -.z> add -.z> move bonk zonk -.z> ls +z/main> builtins.merge +z/main> add +z/main> move bonk zonk +z/main> ls ``` ## Happy Path - Just namespace @@ -57,15 +57,15 @@ bonk.zonk = 5 ``` ```ucm -.a> builtins.merge -.a> add -.a> move bonk zonk -.a> ls -.a> view zonk.zonk +a/main> builtins.merge +a/main> add +a/main> move bonk zonk +a/main> ls +a/main> view zonk.zonk ``` ## Sad Path - No term, type, or namespace named src ```ucm:error -.> move doesntexist foo +scratch/main> move doesntexist foo ``` diff --git a/unison-src/transcripts/move-all.output.md b/unison-src/transcripts/move-all.output.md index f5fefba061..36116ad2bf 100644 --- a/unison-src/transcripts/move-all.output.md +++ b/unison-src/transcripts/move-all.output.md @@ -4,14 +4,14 @@ Create a term, type, and namespace with history -```unison +``` unison Foo = 2 unique type Foo = Foo Foo.termInA = 1 unique type Foo.T = T ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,8 +27,8 @@ unique type Foo.T = T Foo.termInA : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -38,12 +38,12 @@ unique type Foo.T = T Foo.termInA : Nat ``` -```unison +``` unison Foo.termInA = 2 unique type Foo.T = T1 | T2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -59,8 +59,8 @@ unique type Foo.T = T1 | T2 (also named Foo) ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -70,26 +70,26 @@ unique type Foo.T = T1 | T2 ``` Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. -```ucm -.> move Foo Bar +``` ucm +scratch/main> move Foo Bar Done. -.> ls +scratch/main> ls 1. Bar (Nat) 2. Bar (type) 3. Bar/ (4 terms, 1 type) 4. builtin/ (469 terms, 74 types) -.> ls Bar +scratch/main> ls Bar 1. Foo (Bar) 2. T (type) 3. T/ (2 terms) 4. termInA (Nat) -.> history Bar +scratch/main> history Bar Note: The most recent namespace hash is immediately below this message. @@ -109,11 +109,11 @@ Should be able to move the term, type, and namespace, including its types, terms ``` ## Happy Path - Just term -```unison +``` unison bonk = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -126,24 +126,22 @@ bonk = 5 bonk : Nat ``` -```ucm - ☝️ The namespace .z is empty. - -.z> builtins.merge +``` ucm +z/main> builtins.merge Done. -.z> add +z/main> add ⍟ I've added these definitions: bonk : Nat -.z> move bonk zonk +z/main> move bonk zonk Done. -.z> ls +z/main> ls 1. builtin/ (469 terms, 74 types) 2. zonk (Nat) @@ -151,11 +149,11 @@ bonk = 5 ``` ## Happy Path - Just namespace -```unison +``` unison bonk.zonk = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -169,29 +167,27 @@ bonk.zonk = 5 (also named zonk) ``` -```ucm - ☝️ The namespace .a is empty. - -.a> builtins.merge +``` ucm +a/main> builtins.merge Done. -.a> add +a/main> add ⍟ I've added these definitions: bonk.zonk : Nat -.a> move bonk zonk +a/main> move bonk zonk Done. -.a> ls +a/main> ls 1. builtin/ (469 terms, 74 types) 2. zonk/ (1 term) -.a> view zonk.zonk +a/main> view zonk.zonk zonk.zonk : Nat zonk.zonk = 5 @@ -199,8 +195,8 @@ bonk.zonk = 5 ``` ## Sad Path - No term, type, or namespace named src -```ucm -.> move doesntexist foo +``` ucm +scratch/main> move doesntexist foo ⚠️ diff --git a/unison-src/transcripts/move-namespace.md b/unison-src/transcripts/move-namespace.md index 15c66f74c2..e547fdfa21 100644 --- a/unison-src/transcripts/move-namespace.md +++ b/unison-src/transcripts/move-namespace.md @@ -1,9 +1,47 @@ # Tests for `move.namespace` + +## Moving the Root + +I should be able to move the root into a sub-namespace + +```unison:hide +foo = 1 +``` + +```ucm +scratch/main> add +-- Should request confirmation +scratch/main> move.namespace . .root.at.path +scratch/main> move.namespace . .root.at.path +scratch/main> ls +scratch/main> history +``` + +```ucm +scratch/main> ls .root.at.path +scratch/main> history .root.at.path +``` + +I should be able to move a sub namespace _over_ the root. + +```ucm +-- Should request confirmation +scratch/main> move.namespace .root.at.path . +scratch/main> move.namespace .root.at.path . +scratch/main> ls +scratch/main> history +``` + + +```ucm:error +-- should be empty +scratch/main> ls .root.at.path +scratch/main> history .root.at.path +``` + ```ucm:hide -.happy> builtins.merge -.history> builtins.merge -.existing> builtins.merge +scratch/happy> builtins.merge lib.builtins ``` ## Happy path @@ -16,7 +54,7 @@ unique type a.T = T ``` ```ucm -.happy> add +scratch/happy> add ``` ```unison @@ -25,20 +63,23 @@ unique type a.T = T1 | T2 ``` ```ucm -.happy> update +scratch/happy> update ``` Should be able to move the namespace, including its types, terms, and sub-namespaces. ```ucm -.happy> move.namespace a b -.happy> ls b -.happy> history b +scratch/happy> move.namespace a b +scratch/happy> ls b +scratch/happy> history b ``` ## Namespace history +```ucm:hide +scratch/history> builtins.merge lib.builtins +``` Create some namespaces and add some history to them @@ -48,7 +89,7 @@ b.termInB = 10 ``` ```ucm -.history> add +scratch/history> add ``` ```unison @@ -57,24 +98,28 @@ b.termInB = 11 ``` ```ucm -.history> update +scratch/history> update ``` Deleting a namespace should not leave behind any history, if we move another to that location we expect the history to simply be the history -of the moved namespace. +of the moved namespace. ```ucm -.history> delete.namespace b -.history> move.namespace a b +scratch/history> delete.namespace b +scratch/history> move.namespace a b -- Should be the history from 'a' -.history> history b +scratch/history> history b -- Should be empty -.history> history a +scratch/history> history a ``` -## Moving over an existing branch +## Moving over an existing branch + +```ucm:hide +scratch/existing> builtins.merge lib.builtins +``` Create some namespace and add some history to them @@ -84,7 +129,7 @@ b.termInB = 10 ``` ```ucm -.existing> add +scratch/existing> add ``` ```unison @@ -93,40 +138,7 @@ b.termInB = 11 ``` ```ucm -.existing> update -.existing> move.namespace a b -``` - -## Moving the Root - -I should be able to move the root into a sub-namespace - -```ucm --- Should request confirmation -.> move.namespace . .root.at.path -.> move.namespace . .root.at.path -.> ls -.> history -``` - -```ucm -.> ls .root.at.path -.> history .root.at.path -``` - -I should be able to move a sub namespace _over_ the root. - -```ucm --- Should request confirmation -.> move.namespace .root.at.path.happy . -.> move.namespace .root.at.path.happy . -.> ls -.> history +scratch/existing> update +scratch/existing> move.namespace a b ``` - -```ucm:error --- should be empty -.> ls .root.at.path.happy -.> history .root.at.path.happy -``` diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index 9b63baeb67..a93618b0de 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -1,15 +1,116 @@ # Tests for `move.namespace` +## Moving the Root + +I should be able to move the root into a sub-namespace + +``` unison +foo = 1 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : ##Nat + +-- Should request confirmation +scratch/main> move.namespace . .root.at.path + + ⚠️ + + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + +scratch/main> move.namespace . .root.at.path + + Done. + +scratch/main> ls + + 1. root/ (1 term) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #g97lh1m2v7 (start of history) + +``` +``` ucm +scratch/main> ls .root.at.path + + 1. foo (##Nat) + +scratch/main> history .root.at.path + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #08a6hgi6s4 (start of history) + +``` +I should be able to move a sub namespace *over* the root. + +``` ucm +-- Should request confirmation +scratch/main> move.namespace .root.at.path . + + ⚠️ + + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + +scratch/main> move.namespace .root.at.path . + + Done. + +scratch/main> ls + + 1. foo (##Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #08a6hgi6s4 (start of history) + +``` +``` ucm +-- should be empty +scratch/main> ls .root.at.path + + nothing to show + +scratch/main> history .root.at.path + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) + +``` ## Happy path Create a namespace and add some history to it -```unison +``` unison a.termInA = 1 unique type a.T = T ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,8 +124,8 @@ unique type a.T = T a.termInA : Nat ``` -```ucm -.happy> add +``` ucm +scratch/happy> add ⍟ I've added these definitions: @@ -32,12 +133,12 @@ unique type a.T = T a.termInA : Nat ``` -```unison +``` unison a.termInA = 2 unique type a.T = T1 | T2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -52,8 +153,8 @@ unique type a.T = T1 | T2 a.termInA : Nat ``` -```ucm -.happy> update +``` ucm +scratch/happy> update Okay, I'm searching the branch for code that needs to be updated... @@ -63,23 +164,23 @@ unique type a.T = T1 | T2 ``` Should be able to move the namespace, including its types, terms, and sub-namespaces. -```ucm -.happy> move.namespace a b +``` ucm +scratch/happy> move.namespace a b Done. -.happy> ls b +scratch/happy> ls b 1. T (type) 2. T/ (2 terms) 3. termInA (Nat) -.happy> history b +scratch/happy> history b Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #4j747vnmdk + ⊙ 1. #rkvfe5p8fu + Adds / updates: @@ -89,20 +190,19 @@ Should be able to move the namespace, including its types, terms, and sub-namesp T.T - □ 2. #r71j4144fe (start of history) + □ 2. #avlnmh0erc (start of history) ``` ## Namespace history - Create some namespaces and add some history to them -```unison +``` unison a.termInA = 1 b.termInB = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -116,8 +216,8 @@ b.termInB = 10 b.termInB : Nat ``` -```ucm -.history> add +``` ucm +scratch/history> add ⍟ I've added these definitions: @@ -125,12 +225,12 @@ b.termInB = 10 b.termInB : Nat ``` -```unison +``` unison a.termInA = 2 b.termInB = 11 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -145,8 +245,8 @@ b.termInB = 11 b.termInB : Nat ``` -```ucm -.history> update +``` ucm +scratch/history> update Okay, I'm searching the branch for code that needs to be updated... @@ -156,19 +256,19 @@ b.termInB = 11 ``` Deleting a namespace should not leave behind any history, if we move another to that location we expect the history to simply be the history -of the moved namespace. +of the moved namespace. -```ucm -.history> delete.namespace b +``` ucm +scratch/history> delete.namespace b Done. -.history> move.namespace a b +scratch/history> move.namespace a b Done. -- Should be the history from 'a' -.history> history b +scratch/history> history b Note: The most recent namespace hash is immediately below this message. @@ -182,21 +282,26 @@ of the moved namespace. □ 2. #m8smmmgjso (start of history) -- Should be empty -.history> history a +scratch/history> history a - ☝️ The namespace .history.a is empty. + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) ``` -## Moving over an existing branch +## Moving over an existing branch Create some namespace and add some history to them -```unison +``` unison a.termInA = 1 b.termInB = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -210,8 +315,8 @@ b.termInB = 10 b.termInB : Nat ``` -```ucm -.existing> add +``` ucm +scratch/existing> add ⍟ I've added these definitions: @@ -219,12 +324,12 @@ b.termInB = 10 b.termInB : Nat ``` -```unison +``` unison a.termInA = 2 b.termInB = 11 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -239,227 +344,23 @@ b.termInB = 11 b.termInB : Nat ``` -```ucm -.existing> update +``` ucm +scratch/existing> update Okay, I'm searching the branch for code that needs to be updated... Done. -.existing> move.namespace a b +scratch/existing> move.namespace a b ⚠️ A branch existed at the destination: b so I over-wrote it. - Tip: You can use `undo` or `reflog` to undo this change. - - Done. - -``` -## Moving the Root - -I should be able to move the root into a sub-namespace - -```ucm --- Should request confirmation -.> move.namespace . .root.at.path - - ⚠️ - - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -.> move.namespace . .root.at.path - - Done. - -.> ls - - 1. root/ (1412 terms, 223 types) - -.> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #o7cku9c0t9 (start of history) - -``` -```ucm -.> ls .root.at.path - - 1. existing/ (470 terms, 74 types) - 2. happy/ (472 terms, 75 types) - 3. history/ (470 terms, 74 types) - -.> history .root.at.path - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #fv72cqfto4 - - - Deletes: - - existing.b.termInB - - > Moves: - - Original name New name - existing.a.termInA existing.b.termInA - - ⊙ 2. #12iqsb3l9g - - + Adds / updates: - - existing.a.termInA existing.b.termInB - - = Copies: - - Original name New name(s) - happy.b.termInA existing.a.termInA - history.b.termInA existing.a.termInA - - ⊙ 3. #r9jmgtco5u - - + Adds / updates: - - existing.a.termInA existing.b.termInB - - ⊙ 4. #1k6kae1vn4 - - > Moves: - - Original name New name - history.a.termInA history.b.termInA - - ⊙ 5. #ua9re7leg7 - - - Deletes: - - history.b.termInB - - ⊙ 6. #3k8ouql6cc - - + Adds / updates: - - history.a.termInA history.b.termInB - - = Copies: - - Original name New name(s) - happy.b.termInA history.a.termInA - - ⊙ 7. #fp2331i1ek - - + Adds / updates: - - history.a.termInA history.b.termInB - - ⊙ 8. #5sj5jefgcu - - > Moves: - - Original name New name - happy.a.T happy.b.T - happy.a.T.T1 happy.b.T.T1 - happy.a.T.T2 happy.b.T.T2 - happy.a.termInA happy.b.termInA - - ⊙ 9. #ell48pttus - - + Adds / updates: - - happy.a.T happy.a.T.T1 happy.a.T.T2 happy.a.termInA - - - Deletes: - - happy.a.T.T - - ⊙ 10. #al8eguoh70 - - + Adds / updates: - - happy.a.T happy.a.T.T happy.a.termInA - - There's more history before the versions shown here. Use - `history #som3n4m3space` to view history starting from a given - namespace hash. - - ⠇ - - ⊙ 11. #okceqk39nf - - -``` -I should be able to move a sub namespace _over_ the root. - -```ucm --- Should request confirmation -.> move.namespace .root.at.path.happy . - - ⚠️ - - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -.> move.namespace .root.at.path.happy . + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. Done. -.> ls - - 1. b/ (3 terms, 1 type) - 2. builtin/ (469 terms, 74 types) - -.> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #0rvi5q5une - - + Adds / updates: - - b.T b.T.T1 b.T.T2 b.termInA - - ⊙ 2. #oaa8ltdusf - - - Deletes: - - a.T a.T.T1 a.T.T2 a.termInA - - ⊙ 3. #t1c91ou7ri - - + Adds / updates: - - a.T a.T.T1 a.T.T2 a.termInA - - - Deletes: - - a.T.T - - ⊙ 4. #hovh08jep4 - - + Adds / updates: - - a.T a.T.T a.termInA - - □ 5. #4bigcpnl7t (start of history) - -``` -```ucm --- should be empty -.> ls .root.at.path.happy - - nothing to show - -.> history .root.at.path.happy - - ☝️ The namespace .root.at.path.happy is empty. - ``` diff --git a/unison-src/transcripts/name-segment-escape.md b/unison-src/transcripts/name-segment-escape.md index a782953188..bf6bca128d 100644 --- a/unison-src/transcripts/name-segment-escape.md +++ b/unison-src/transcripts/name-segment-escape.md @@ -1,8 +1,8 @@ You can use a keyword or reserved operator as a name segment if you surround it with backticks. ```ucm:error -.> view `match` -.> view `=` +scratch/main> view `match` +scratch/main> view `=` ``` You can also use backticks to expand the set of valid symbols in a symboly name segment to include these three: `.()` @@ -10,6 +10,6 @@ You can also use backticks to expand the set of valid symbols in a symboly name This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). ```ucm:error -.> view `.` -.> view `()` +scratch/main> view `.` +scratch/main> view `()` ``` diff --git a/unison-src/transcripts/name-segment-escape.output.md b/unison-src/transcripts/name-segment-escape.output.md index 7eef020774..4a58422746 100644 --- a/unison-src/transcripts/name-segment-escape.output.md +++ b/unison-src/transcripts/name-segment-escape.output.md @@ -1,14 +1,14 @@ You can use a keyword or reserved operator as a name segment if you surround it with backticks. -```ucm -.> view `match` +``` ucm +scratch/main> view `match` ⚠️ The following names were not found in the codebase. Check your spelling. `match` -.> view `=` +scratch/main> view `=` ⚠️ @@ -20,15 +20,15 @@ You can also use backticks to expand the set of valid symbols in a symboly name This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). -```ucm -.> view `.` +``` ucm +scratch/main> view `.` ⚠️ The following names were not found in the codebase. Check your spelling. `.` -.> view `()` +scratch/main> view `()` ⚠️ diff --git a/unison-src/transcripts/name-selection.md b/unison-src/transcripts/name-selection.md index 992ee79491..5443349c0d 100644 --- a/unison-src/transcripts/name-selection.md +++ b/unison-src/transcripts/name-selection.md @@ -5,53 +5,45 @@ This transcript shows how the pretty-printer picks names for a hash when multipl 3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. ```ucm:hide -.a> builtins.merge -.a2> builtins.merge -.a3> builtins.merge -.biasing> builtins.merge +scratch/main> builtins.merge lib.builtins +scratch/biasing> builtins.merge lib.builtins ``` ```unison:hide -a = b + 1 -b = 0 + 1 +a.a = a.b + 1 +a.b = 0 + 1 +a.aaa.but.more.segments = 0 + 1 ``` Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: ```ucm -.a> add -.a> alias.term b aaa.but.more.segments -.a> view a +scratch/main> add +scratch/main> view a.a ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: -``` -.> fork a a2 -.> fork a a3 -``` - -```unison:hide -c = 1 -d = c + 10 -``` - -```ucm:hide -.a2> builtins.merge -``` -```ucm -.a2> add -.a2> alias.term c long.name.but.shortest.suffixification -``` - ```unison:hide -c = 2 -d = c + 10 +a2.a = a2.b + 1 +a2.b = 0 + 1 +a2.aaa.but.more.segments = 0 + 1 +a2.c = 1 +a2.d = a2.c + 10 +a2.long.name.but.shortest.suffixification = 1 + +a3.a = a3.b + 1 +a3.b = 0 + 1 +a3.aaa.but.more.segments = 0 + 1 +a3.c = 2 +a3.d = a3.c + 10 +a3.long.name.but.shortest.suffixification = 1 ``` ```ucm -.a3> add -.a3> merge.old .a2 .a3 +scratch/main> add +scratch/main> debug.alias.term.force a2.c a3.c +scratch/main> debug.alias.term.force a2.d a3.d ``` At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. @@ -59,7 +51,7 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but `a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. ```ucm -.> view a b c d +scratch/main> view a b c d ``` ## Name biasing @@ -74,11 +66,11 @@ a = 10 ``` ```ucm -.biasing> add +scratch/biasing> add -- Despite being saved with name `a`, -- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. -- It's closer to the term being printed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term ``` Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` @@ -88,8 +80,8 @@ other.num = 20 ``` ```ucm -.biasing> add +scratch/biasing> add -- nested.num should be preferred over the shorter name `a` due to biasing -- because `deeply.nested.num` is nearby to the term being viewed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term ``` diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md index e124c18a20..10bb357c98 100644 --- a/unison-src/transcripts/name-selection.output.md +++ b/unison-src/transcripts/name-selection.output.md @@ -1,110 +1,91 @@ This transcript shows how the pretty-printer picks names for a hash when multiple are available. The algorithm is: -1. Names that are "name-only" come before names that are hash qualified. So `List.map` comes before `List.map#2384a` and also `aaaa#xyz`. -2. Shorter names (in terms of segment count) come before longer ones, for instance `base.List.map` comes before `somelibrary.external.base.List.map`. -3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. - -```unison -a = b + 1 -b = 0 + 1 +1. Names that are "name-only" come before names that are hash qualified. So `List.map` comes before `List.map#2384a` and also `aaaa#xyz`. +2. Shorter names (in terms of segment count) come before longer ones, for instance `base.List.map` comes before `somelibrary.external.base.List.map`. +3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. + +``` unison +a.a = a.b + 1 +a.b = 0 + 1 +a.aaa.but.more.segments = 0 + 1 ``` Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: -```ucm -.a> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - a : Nat - b : Nat - -.a> alias.term b aaa.but.more.segments - - Done. + a.a : Nat + a.aaa.but.more.segments : Nat + a.b : Nat -.a> view a +scratch/main> view a.a - a : Nat - a = + a.a : Nat + a.a = use Nat + b + 1 ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: +``` unison +a2.a = a2.b + 1 +a2.b = 0 + 1 +a2.aaa.but.more.segments = 0 + 1 +a2.c = 1 +a2.d = a2.c + 10 +a2.long.name.but.shortest.suffixification = 1 + +a3.a = a3.b + 1 +a3.b = 0 + 1 +a3.aaa.but.more.segments = 0 + 1 +a3.c = 2 +a3.d = a3.c + 10 +a3.long.name.but.shortest.suffixification = 1 ``` -.> fork a a2 -.> fork a a3 -``` - -```unison -c = 1 -d = c + 10 -``` - -```ucm -.a2> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - c : Nat - d : Nat - -.a2> alias.term c long.name.but.shortest.suffixification + a2.a : Nat + (also named a.a) + a2.aaa.but.more.segments : Nat + (also named a.b and a.aaa.but.more.segments) + a2.b : Nat + (also named a.b and a.aaa.but.more.segments) + a2.c : Nat + a2.d : Nat + a2.long.name.but.shortest.suffixification : Nat + a3.a : Nat + (also named a.a) + a3.aaa.but.more.segments : Nat + (also named a.b and a.aaa.but.more.segments) + a3.b : Nat + (also named a.b and a.aaa.but.more.segments) + a3.c : Nat + a3.d : Nat + a3.long.name.but.shortest.suffixification : Nat + +scratch/main> debug.alias.term.force a2.c a3.c Done. -``` -```unison -c = 2 -d = c + 10 -``` - -```ucm -.a3> add - - ⍟ I've added these definitions: - - c : Nat - d : Nat +scratch/main> debug.alias.term.force a2.d a3.d -.a3> merge.old .a2 .a3 - - Here's what's changed in .a3 after the merge: - - New name conflicts: - - 1. c#dcgdua2lj6 : Nat - ↓ - 2. ┌ c#dcgdua2lj6 : Nat - 3. └ c#gjmq673r1v : Nat - - 4. d#9ivhgvhthc : Nat - ↓ - 5. ┌ d#9ivhgvhthc : Nat - 6. └ d#ve16e6jmf6 : Nat - - Added definitions: - - 7. ┌ c#gjmq673r1v : Nat - 8. └ long.name.but.shortest.suffixification : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... + Done. ``` At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. The original `a2` namespace has an unconflicted definition for `c` and `d`, but since there are multiple 'c's in scope, `a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. -```ucm -.> view a b c d +``` ucm +scratch/main> view a b c d a.a : Nat a.a = @@ -135,7 +116,7 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but ``` ## Name biasing -```unison +``` unison deeply.nested.term = a + 1 @@ -144,7 +125,7 @@ deeply.nested.num = 10 a = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -159,8 +140,8 @@ a = 10 deeply.nested.term : Nat ``` -```ucm -.biasing> add +``` ucm +scratch/biasing> add ⍟ I've added these definitions: @@ -171,7 +152,7 @@ a = 10 -- Despite being saved with name `a`, -- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. -- It's closer to the term being printed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term deeply.nested.term : Nat deeply.nested.term = @@ -181,11 +162,11 @@ a = 10 ``` Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` -```unison +``` unison other.num = 20 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -198,8 +179,8 @@ other.num = 20 other.num : Nat ``` -```ucm -.biasing> add +``` ucm +scratch/biasing> add ⍟ I've added these definitions: @@ -207,7 +188,7 @@ other.num = 20 -- nested.num should be preferred over the shorter name `a` due to biasing -- because `deeply.nested.num` is nearby to the term being viewed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term deeply.nested.term : Nat deeply.nested.term = diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 6d395266c4..7780292f42 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -1,5 +1,9 @@ # `names` command +```ucm +scratch/main> builtins.merge lib.builtins +``` + Example uses of the `names` command and output ```unison @@ -13,7 +17,7 @@ somewhere.y = 2 ``` ```ucm -.> add +scratch/main> add ``` @@ -21,22 +25,23 @@ somewhere.y = 2 ```ucm -- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. --- But we don't see somewhere.z which is has the same value but is out of our namespace -.some> names x +scratch/main> names x -- We can search by hash, and see all aliases of that hash -.some> names #gjmq673r1v --- If the query is absolute, treat it as a `names.global` -.some> names .some.place.x +scratch/main> names #gjmq673r1v +-- Works with absolute names too +scratch/main> names .some.place.x ``` `names.global` searches from the root, and absolutely qualifies results -```ucm --- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. -.some> names.global x +TODO: swap this back to a 'ucm' block when names.global is re-implemented + +``` +-- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. +scratch/other> names.global x -- We can search by hash, and see all aliases of that hash in the codebase -.some> names.global #gjmq673r1v +scratch/other> names.global #gjmq673r1v -- We can search using an absolute name -.some> names.global .some.place.x +scratch/other> names.global .some.place.x ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 8138b5434d..27b986afb0 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -1,8 +1,14 @@ # `names` command +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +``` Example uses of the `names` command and output -```unison +``` unison -- Some names with the same value some.place.x = 1 some.otherplace.y = 1 @@ -12,7 +18,7 @@ somewhere.z = 1 somewhere.y = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,86 +28,69 @@ somewhere.y = 2 ⍟ These new definitions are ok to `add`: - some.otherplace.x : ##Nat - some.otherplace.y : ##Nat - some.place.x : ##Nat - somewhere.y : ##Nat - somewhere.z : ##Nat + some.otherplace.x : Nat + some.otherplace.y : Nat + some.place.x : Nat + somewhere.y : Nat + somewhere.z : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - some.otherplace.x : ##Nat - some.otherplace.y : ##Nat - some.place.x : ##Nat - somewhere.y : ##Nat - somewhere.z : ##Nat + some.otherplace.x : Nat + some.otherplace.y : Nat + some.place.x : Nat + somewhere.y : Nat + somewhere.z : Nat ``` `names` searches relative to the current path. -```ucm +``` ucm -- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. --- But we don't see somewhere.z which is has the same value but is out of our namespace -.some> names x +scratch/main> names x Terms Hash: #gjmq673r1v - Names: otherplace.y place.x + Names: some.otherplace.y some.place.x somewhere.z Hash: #pi25gcdv0o - Names: otherplace.x + Names: some.otherplace.x Tip: Use `names.global` to see more results. -- We can search by hash, and see all aliases of that hash -.some> names #gjmq673r1v +scratch/main> names #gjmq673r1v Term Hash: #gjmq673r1v - Names: otherplace.y place.x + Names: some.otherplace.y some.place.x somewhere.z Tip: Use `names.global` to see more results. --- If the query is absolute, treat it as a `names.global` -.some> names .some.place.x +-- Works with absolute names too +scratch/main> names .some.place.x Term Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z + Names: some.otherplace.y some.place.x somewhere.z Tip: Use `names.global` to see more results. ``` `names.global` searches from the root, and absolutely qualifies results +TODO: swap this back to a 'ucm' block when names.global is re-implemented -```ucm --- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. -.some> names.global x - - Terms - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z - - Hash: #pi25gcdv0o - Names: .some.otherplace.x - +``` +-- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. +scratch/other> names.global x -- We can search by hash, and see all aliases of that hash in the codebase -.some> names.global #gjmq673r1v - - Term - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z - +scratch/other> names.global #gjmq673r1v -- We can search using an absolute name -.some> names.global .some.place.x - - Term - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z - +scratch/other> names.global .some.place.x ``` + diff --git a/unison-src/transcripts/namespace-deletion-regression.md b/unison-src/transcripts/namespace-deletion-regression.md index d33a707100..a1bc14ca3c 100644 --- a/unison-src/transcripts/namespace-deletion-regression.md +++ b/unison-src/transcripts/namespace-deletion-regression.md @@ -8,9 +8,9 @@ Previously the following sequence delete the current namespace unexpectedly 😬. ```ucm -.> alias.term ##Nat.+ .Nat.+ -.> ls Nat -.> move.namespace Nat Nat.operators -.> ls Nat -.> ls Nat.operators +scratch/main> alias.term ##Nat.+ Nat.+ +scratch/main> ls Nat +scratch/main> move.namespace Nat Nat.operators +scratch/main> ls Nat +scratch/main> ls Nat.operators ``` diff --git a/unison-src/transcripts/namespace-deletion-regression.output.md b/unison-src/transcripts/namespace-deletion-regression.output.md index 45af1bfcb3..1730897d3e 100644 --- a/unison-src/transcripts/namespace-deletion-regression.output.md +++ b/unison-src/transcripts/namespace-deletion-regression.output.md @@ -7,24 +7,24 @@ If branch operations aren't performed in the correct order it's possible to end Previously the following sequence delete the current namespace unexpectedly 😬. -```ucm -.> alias.term ##Nat.+ .Nat.+ +``` ucm +scratch/main> alias.term ##Nat.+ Nat.+ Done. -.> ls Nat +scratch/main> ls Nat 1. + (##Nat -> ##Nat -> ##Nat) -.> move.namespace Nat Nat.operators +scratch/main> move.namespace Nat Nat.operators Done. -.> ls Nat +scratch/main> ls Nat 1. operators/ (1 term) -.> ls Nat.operators +scratch/main> ls Nat.operators 1. + (##Nat -> ##Nat -> ##Nat) diff --git a/unison-src/transcripts/namespace-dependencies.md b/unison-src/transcripts/namespace-dependencies.md new file mode 100644 index 0000000000..d60f789367 --- /dev/null +++ b/unison-src/transcripts/namespace-dependencies.md @@ -0,0 +1,16 @@ +# namespace.dependencies command + +```ucm +scratch/main> builtins.merge lib.builtins +``` + +```unison:hide +const a b = a +external.mynat = 1 +mynamespace.dependsOnText = const external.mynat 10 +``` + +```ucm +scratch/main> add +scratch/main> namespace.dependencies mynamespace +``` diff --git a/unison-src/transcripts/namespace-dependencies.output.md b/unison-src/transcripts/namespace-dependencies.output.md new file mode 100644 index 0000000000..f263473bf6 --- /dev/null +++ b/unison-src/transcripts/namespace-dependencies.output.md @@ -0,0 +1,33 @@ +# namespace.dependencies command + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +``` +``` unison +const a b = a +external.mynat = 1 +mynamespace.dependsOnText = const external.mynat 10 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + const : a -> b -> a + external.mynat : Nat + mynamespace.dependsOnText : Nat + +scratch/main> namespace.dependencies mynamespace + + External dependency Dependents in scratch/main:.mynamespace + lib.builtins.Nat 1. dependsOnText + + const 1. dependsOnText + + external.mynat 1. dependsOnText + +``` diff --git a/unison-src/transcripts/numbered-args.md b/unison-src/transcripts/numbered-args.md index f421a67177..02172710bc 100644 --- a/unison-src/transcripts/numbered-args.md +++ b/unison-src/transcripts/numbered-args.md @@ -1,7 +1,7 @@ # Using numbered arguments in UCM ```ucm:hide -.temp> alias.type ##Text Text +scratch/main> alias.type ##Text Text ``` First lets add some contents to our codebase. @@ -16,41 +16,41 @@ corge = "corge" ``` ```ucm -.temp> add +scratch/main> add ``` We can get the list of things in the namespace, and UCM will give us a numbered list: ```ucm -.temp> find +scratch/main> find ``` We can ask to `view` the second element of this list: ```ucm -.temp> find -.temp> view 2 +scratch/main> find +scratch/main> view 2 ``` And we can `view` multiple elements by separating with spaces: ```ucm -.temp> find -.temp> view 2 3 5 +scratch/main> find +scratch/main> view 2 3 5 ``` We can also ask for a range: ```ucm -.temp> find -.temp> view 2-4 +scratch/main> find +scratch/main> view 2-4 ``` And we can ask for multiple ranges and use mix of ranges and numbers: ```ucm -.temp> find -.temp> view 1-3 4 5-6 +scratch/main> find +scratch/main> view 1-3 4 5-6 ``` diff --git a/unison-src/transcripts/numbered-args.output.md b/unison-src/transcripts/numbered-args.output.md index b8dfce49f2..0567bcac3f 100644 --- a/unison-src/transcripts/numbered-args.output.md +++ b/unison-src/transcripts/numbered-args.output.md @@ -2,7 +2,7 @@ First lets add some contents to our codebase. -```unison +``` unison foo = "foo" bar = "bar" baz = "baz" @@ -11,7 +11,7 @@ quux = "quux" corge = "corge" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,8 +29,8 @@ corge = "corge" qux : Text ``` -```ucm -.temp> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -45,8 +45,8 @@ corge = "corge" We can get the list of things in the namespace, and UCM will give us a numbered list: -```ucm -.temp> find +``` ucm +scratch/main> find 1. bar : Text 2. baz : Text @@ -60,8 +60,8 @@ list: ``` We can ask to `view` the second element of this list: -```ucm -.temp> find +``` ucm +scratch/main> find 1. bar : Text 2. baz : Text @@ -72,7 +72,7 @@ We can ask to `view` the second element of this list: 7. builtin type Text -.temp> view 2 +scratch/main> view 2 baz : Text baz = "baz" @@ -80,8 +80,8 @@ We can ask to `view` the second element of this list: ``` And we can `view` multiple elements by separating with spaces: -```ucm -.temp> find +``` ucm +scratch/main> find 1. bar : Text 2. baz : Text @@ -92,7 +92,7 @@ And we can `view` multiple elements by separating with spaces: 7. builtin type Text -.temp> view 2 3 5 +scratch/main> view 2 3 5 baz : Text baz = "baz" @@ -106,8 +106,8 @@ And we can `view` multiple elements by separating with spaces: ``` We can also ask for a range: -```ucm -.temp> find +``` ucm +scratch/main> find 1. bar : Text 2. baz : Text @@ -118,7 +118,7 @@ We can also ask for a range: 7. builtin type Text -.temp> view 2-4 +scratch/main> view 2-4 baz : Text baz = "baz" @@ -132,8 +132,8 @@ We can also ask for a range: ``` And we can ask for multiple ranges and use mix of ranges and numbers: -```ucm -.temp> find +``` ucm +scratch/main> find 1. bar : Text 2. baz : Text @@ -144,7 +144,7 @@ And we can ask for multiple ranges and use mix of ranges and numbers: 7. builtin type Text -.temp> view 1-3 4 5-6 +scratch/main> view 1-3 4 5-6 bar : Text bar = "bar" diff --git a/unison-src/transcripts/old-fold-right.md b/unison-src/transcripts/old-fold-right.md index f3c01d5d01..179ad5b936 100644 --- a/unison-src/transcripts/old-fold-right.md +++ b/unison-src/transcripts/old-fold-right.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/old-fold-right.output.md b/unison-src/transcripts/old-fold-right.output.md index 4f210513b9..a74a317a49 100644 --- a/unison-src/transcripts/old-fold-right.output.md +++ b/unison-src/transcripts/old-fold-right.output.md @@ -1,4 +1,4 @@ -```unison +``` unison oldRight: (b ->{e} a ->{e} b) -> [a] ->{e} [b] oldRight f la = bug "out" @@ -11,7 +11,7 @@ pecan = 'let oldRight f la ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/pattern-match-coverage.md b/unison-src/transcripts/pattern-match-coverage.md index 8c35e07d55..e08ea269ab 100644 --- a/unison-src/transcripts/pattern-match-coverage.md +++ b/unison-src/transcripts/pattern-match-coverage.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` # Basics @@ -292,7 +292,7 @@ unit2t = cases ``` ```ucm -.> add +scratch/main> add ``` Pattern coverage checking needs the data decl map to contain all @@ -316,7 +316,7 @@ evil = bug "" ``` ```ucm -.> add +scratch/main> add ``` ```unison:error @@ -330,7 +330,7 @@ unique type SomeType = A ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md index 0a0b290c99..575c35cab0 100644 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ b/unison-src/transcripts/pattern-match-coverage.output.md @@ -1,6 +1,8 @@ # Basics + ## non-exhaustive patterns -```unison + +``` unison unique type T = A | B | C test : T -> () @@ -8,7 +10,7 @@ test = cases A -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,7 +25,7 @@ test = cases * C ``` -```unison +``` unison unique type T = A | B test : (T, Optional T) -> () @@ -34,7 +36,7 @@ test = cases (B, None) -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,7 +53,8 @@ test = cases ``` ## redundant patterns -```unison + +``` unison unique type T = A | B | C test : T -> () @@ -62,7 +65,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -71,7 +74,7 @@ test = cases ``` -```unison +``` unison unique type T = A | B test : (T, Optional T) -> () @@ -83,7 +86,7 @@ test = cases (A, Some A) -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -95,7 +98,8 @@ test = cases # Uninhabited patterns match is complete without covering uninhabited patterns -```unison + +``` unison unique type V = test : Optional (Optional V) -> () @@ -104,7 +108,7 @@ test = cases Some None -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -119,7 +123,8 @@ test = cases ``` uninhabited patterns are reported as redundant -```unison + +``` unison unique type V = test0 : V -> () @@ -127,7 +132,7 @@ test0 = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -136,7 +141,7 @@ test0 = cases ``` -```unison +``` unison unique type V = test : Optional (Optional V) -> () @@ -146,7 +151,7 @@ test = cases Some _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -158,13 +163,14 @@ test = cases # Guards ## Incomplete patterns due to guards should be reported -```unison + +``` unison test : () -> () test = cases () | false -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -177,7 +183,7 @@ test = cases * () ``` -```unison +``` unison test : Optional Nat -> Nat test = cases None -> 0 @@ -185,7 +191,7 @@ test = cases | isEven x -> x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -201,7 +207,8 @@ test = cases ``` ## Complete patterns with guards should be accepted -```unison + +``` unison test : Optional Nat -> Nat test = cases None -> 0 @@ -210,7 +217,7 @@ test = cases | otherwise -> 0 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -227,7 +234,8 @@ test = cases Uncovered patterns are only instantiated as deeply as necessary to distinguish them from existing patterns. -```unison + +``` unison unique type T = A | B | C test : Optional (Optional T) -> () @@ -236,7 +244,7 @@ test = cases Some None -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -250,7 +258,7 @@ test = cases * Some (Some _) ``` -```unison +``` unison unique type T = A | B | C test : Optional (Optional T) -> () @@ -260,7 +268,7 @@ test = cases Some (Some A) -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -282,13 +290,14 @@ test = cases ## Non-exhaustive Nat -```unison + +``` unison test : Nat -> () test = cases 0 -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -302,13 +311,14 @@ test = cases ``` Boolean -```unison + +``` unison test : Boolean -> () test = cases true -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -324,14 +334,15 @@ test = cases ## Exhaustive Nat -```unison + +``` unison test : Nat -> () test = cases 0 -> () _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -345,14 +356,15 @@ test = cases ``` Boolean -```unison + +``` unison test : Boolean -> () test = cases true -> () false -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -368,7 +380,8 @@ test = cases # Redundant Nat -```unison + +``` unison test : Nat -> () test = cases 0 -> () @@ -376,7 +389,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -386,7 +399,8 @@ test = cases ``` Boolean -```unison + +``` unison test : Boolean -> () test = cases true -> () @@ -394,7 +408,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -406,14 +420,15 @@ test = cases # Sequences ## Exhaustive -```unison + +``` unison test : [()] -> () test = cases [] -> () x +: xs -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -427,13 +442,14 @@ test = cases ``` ## Non-exhaustive -```unison + +``` unison test : [()] -> () test = cases [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -446,13 +462,13 @@ test = cases * (() +: _) ``` -```unison +``` unison test : [()] -> () test = cases x +: xs -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -465,13 +481,13 @@ test = cases * [] ``` -```unison +``` unison test : [()] -> () test = cases xs :+ x -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -484,14 +500,14 @@ test = cases * [] ``` -```unison +``` unison test : [()] -> () test = cases x0 +: (x1 +: xs) -> () [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -505,14 +521,14 @@ test = cases * (() +: []) ``` -```unison +``` unison test : [()] -> () test = cases [] -> () x0 +: [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -529,7 +545,8 @@ test = cases ## Uninhabited `Cons` is not expected since `V` is uninhabited -```unison + +``` unison unique type V = test : [V] -> () @@ -537,7 +554,7 @@ test = cases [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -559,7 +576,8 @@ final element is `false`, while the fourth pattern matches when the first element is `true`. However, the only possible list length at the third or fourth clause is 1, so the first and final element must be equal. Thus, the pattern match is exhaustive. -```unison + +``` unison test : [Boolean] -> () test = cases [a, b] ++ xs -> () @@ -568,7 +586,7 @@ test = cases true +: xs -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -582,7 +600,8 @@ test = cases ``` This is the same idea as above but shows that fourth match is redundant. -```unison + +``` unison test : [Boolean] -> () test = cases [a, b] ++ xs -> () @@ -592,7 +611,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -607,7 +626,8 @@ first and third element are true. The third matches lists of length 4 or greater where the final 4 elements are `true, false, true, false`. The list must be exactly of length 4 to arrive at the second or third clause, so the third pattern is redundant. -```unison + +``` unison test : [Boolean] -> () test = cases [a, b, c, d, f] ++ xs -> () @@ -616,7 +636,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -627,7 +647,7 @@ test = cases ``` # bugfix: Sufficient data decl map -```unison +``` unison unique type T = A unit2t : Unit -> T @@ -635,7 +655,7 @@ unit2t = cases () -> A ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -649,8 +669,8 @@ unit2t = cases unit2t : 'T ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -665,13 +685,14 @@ transitive type dependencies of references that appear in the expression. This test ensures that we have fetched the `T` type although there is no data decl reference to `T` in `witht`. -```unison + +``` unison witht : Unit witht = match unit2t () with x -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -684,14 +705,14 @@ witht = match unit2t () with witht : () ``` -```unison +``` unison unique type V = evil : Unit -> V evil = bug "" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -705,8 +726,8 @@ evil = bug "" evil : 'V ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -714,13 +735,13 @@ evil = bug "" evil : 'V ``` -```unison +``` unison withV : Unit withV = match evil () with x -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -729,11 +750,11 @@ withV = match evil () with ``` -```unison +``` unison unique type SomeType = A ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -746,22 +767,22 @@ unique type SomeType = A type SomeType ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type SomeType ``` -```unison +``` unison unique type R = R SomeType get x = match x with R y -> y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -775,11 +796,11 @@ get x = match x with get : R -> SomeType ``` -```unison +``` unison unique type R = { someType : SomeType } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -799,7 +820,7 @@ unique type R = { someType : SomeType } ## Exhaustive ability handlers are accepted -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -810,7 +831,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -824,7 +845,7 @@ result f = handle !f with cases result : '{e, Abort} a ->{e} a ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -837,7 +858,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -856,7 +877,7 @@ result f = handle !f with cases type T ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -868,7 +889,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -882,7 +903,7 @@ result f = result : '{e, Abort} V ->{e} V ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -898,7 +919,7 @@ handleMulti c = handle !c with impl [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -915,7 +936,7 @@ handleMulti c = ``` ## Non-exhaustive ability handlers are rejected -```unison +``` unison structural ability Abort where abort : {Abort} a abortWithMessage : Text -> {Abort} a @@ -926,7 +947,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -941,7 +962,7 @@ result f = handle !f with cases * { abortWithMessage _ -> _ } ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -953,7 +974,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -967,7 +988,7 @@ result f = handle !f with cases * { B } ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit @@ -979,7 +1000,7 @@ result f = handle !f with cases { give A -> resume } -> result resume ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -993,7 +1014,7 @@ result f = handle !f with cases * { give B -> _ } ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -1009,7 +1030,7 @@ handleMulti c = handle !c with impl [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1025,7 +1046,7 @@ handleMulti c = ``` ## Redundant handler cases are rejected -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit @@ -1038,7 +1059,7 @@ result f = handle !f with cases { give A -> resume } -> result resume ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1049,7 +1070,7 @@ result f = handle !f with cases ``` ## Exhaustive ability reinterpretations are accepted -```unison +``` unison structural ability Abort where abort : {Abort} a abortWithMessage : Text -> {Abort} a @@ -1062,7 +1083,7 @@ result f = handle !f with cases { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1076,7 +1097,7 @@ result f = handle !f with cases result : '{e, Abort} a ->{e, Abort} a ``` -```unison +``` unison structural ability Abort a where abort : {Abort a} r abortWithMessage : a -> {Abort a} r @@ -1090,7 +1111,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1106,7 +1127,7 @@ result f = ``` ## Non-exhaustive ability reinterpretations are rejected -```unison +``` unison structural ability Abort where abort : {Abort} a abortWithMessage : Text -> {Abort} a @@ -1118,7 +1139,7 @@ result f = handle !f with cases { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1145,7 +1166,7 @@ they are all uninhabited. The messages here aren't the best, but I don't think uninhabited abilities will come up and get handlers written for them often. -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1158,7 +1179,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1173,7 +1194,7 @@ result f = * { give2 _ -> _ } ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1187,7 +1208,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1201,7 +1222,7 @@ result f = result : '{e, Give V} r ->{e} r ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1215,7 +1236,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1229,7 +1250,7 @@ result f = result : '{e, Give V} r ->{e} r ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1244,7 +1265,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1253,7 +1274,7 @@ result f = ``` -```unison +``` unison unique ability GiveA a where giveA : a -> {GiveA a} Unit giveA2 : a -> {GiveA a} Unit @@ -1274,7 +1295,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1283,7 +1304,7 @@ result f = ``` -```unison +``` unison unique ability GiveA a where giveA : a -> {GiveA a} Unit giveA2 : a -> {GiveA a} Unit @@ -1302,7 +1323,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/pattern-pretty-print-2345.md b/unison-src/transcripts/pattern-pretty-print-2345.md index 0879808f2d..8728aa4d83 100644 --- a/unison-src/transcripts/pattern-pretty-print-2345.md +++ b/unison-src/transcripts/pattern-pretty-print-2345.md @@ -2,7 +2,7 @@ Regression test for https://github.com/unisonweb/unison/pull/2377 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -65,21 +65,21 @@ doc = cases ``` ```ucm -.> add -.> view dopey -.> view grumpy -.> view happy -.> view sneezy -.> view bashful -.> view mouthy -.> view pokey -.> view sleepy -.> view demure -.> view angry -.> view tremulous -.> view throaty -.> view agitated -.> view doc +scratch/main> add +scratch/main> view dopey +scratch/main> view grumpy +scratch/main> view happy +scratch/main> view sneezy +scratch/main> view bashful +scratch/main> view mouthy +scratch/main> view pokey +scratch/main> view sleepy +scratch/main> view demure +scratch/main> view angry +scratch/main> view tremulous +scratch/main> view throaty +scratch/main> view agitated +scratch/main> view doc ``` diff --git a/unison-src/transcripts/pattern-pretty-print-2345.output.md b/unison-src/transcripts/pattern-pretty-print-2345.output.md index 6c239772d2..7112974125 100644 --- a/unison-src/transcripts/pattern-pretty-print-2345.output.md +++ b/unison-src/transcripts/pattern-pretty-print-2345.output.md @@ -1,7 +1,6 @@ Regression test for https://github.com/unisonweb/unison/pull/2377 - -```unison +``` unison structural ability Ab where a: Nat -> () @@ -60,7 +59,7 @@ doc = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -87,8 +86,8 @@ doc = cases tremulous : (Nat, Nat) -> () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -108,94 +107,94 @@ doc = cases throaty : Request {g, Ab} x -> () tremulous : (Nat, Nat) -> () -.> view dopey +scratch/main> view dopey dopey : Char -> () dopey = cases ?0 -> () _ -> () -.> view grumpy +scratch/main> view grumpy grumpy : ff284oqf651 -> () grumpy = cases d -> () -.> view happy +scratch/main> view happy happy : Boolean -> () happy = cases true -> () false -> () -.> view sneezy +scratch/main> view sneezy sneezy : Int -> () sneezy = cases +1 -> () _ -> () -.> view bashful +scratch/main> view bashful bashful : Optional a -> () bashful = cases Some a -> () _ -> () -.> view mouthy +scratch/main> view mouthy mouthy : [t] -> () mouthy = cases [] -> () _ -> () -.> view pokey +scratch/main> view pokey pokey : [t] -> () pokey = cases h +: t -> () _ -> () -.> view sleepy +scratch/main> view sleepy sleepy : [t] -> () sleepy = cases i :+ l -> () _ -> () -.> view demure +scratch/main> view demure demure : [Nat] -> () demure = cases [0] -> () _ -> () -.> view angry +scratch/main> view angry angry : [t] -> () angry = cases a ++ [] -> () -.> view tremulous +scratch/main> view tremulous tremulous : (Nat, Nat) -> () tremulous = cases (0, 1) -> () _ -> () -.> view throaty +scratch/main> view throaty throaty : Request {g, Ab} x -> () throaty = cases { Ab.a a -> k } -> () { _ } -> () -.> view agitated +scratch/main> view agitated agitated : Nat -> () agitated = cases a | a == 2 -> () _ -> () -.> view doc +scratch/main> view doc doc : Nat -> () doc = cases diff --git a/unison-src/transcripts/patternMatchTls.md b/unison-src/transcripts/patternMatchTls.md index cfe5b177cf..dbd8510716 100644 --- a/unison-src/transcripts/patternMatchTls.md +++ b/unison-src/transcripts/patternMatchTls.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` We had bugs in the calling conventions for both send and terminate which would @@ -29,6 +29,6 @@ assertRight = cases ```ucm -.> add -.> run frank +scratch/main> add +scratch/main> run frank ``` diff --git a/unison-src/transcripts/patternMatchTls.output.md b/unison-src/transcripts/patternMatchTls.output.md index b1f82833b5..1e6e9ced27 100644 --- a/unison-src/transcripts/patternMatchTls.output.md +++ b/unison-src/transcripts/patternMatchTls.output.md @@ -1,9 +1,7 @@ We had bugs in the calling conventions for both send and terminate which would cause pattern matching on the resulting (Right ()) would cause a runtime error. - - -```unison +``` unison use builtin.io2.Tls newClient send handshake terminate frank: '{IO} () @@ -22,7 +20,7 @@ assertRight = cases Left _ -> bug "expected a right but got a left" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,15 +34,15 @@ assertRight = cases frank : '{IO} () ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: assertRight : Either a b -> b frank : '{IO} () -.> run frank +scratch/main> run frank () diff --git a/unison-src/transcripts/patterns.md b/unison-src/transcripts/patterns.md index 104d1bc8ae..8eb309ad75 100644 --- a/unison-src/transcripts/patterns.md +++ b/unison-src/transcripts/patterns.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Some tests of pattern behavior. diff --git a/unison-src/transcripts/patterns.output.md b/unison-src/transcripts/patterns.output.md index 7db153f99b..f68423848f 100644 --- a/unison-src/transcripts/patterns.output.md +++ b/unison-src/transcripts/patterns.output.md @@ -1,13 +1,13 @@ Some tests of pattern behavior. -```unison +``` unison p1 = join [literal "blue", literal "frog"] > Pattern.run (many p1) "bluefrogbluegoat" > Pattern.run (many.corrected p1) "bluefrogbluegoat" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/project-merge.md b/unison-src/transcripts/project-merge.md deleted file mode 100644 index d18fd89cfd..0000000000 --- a/unison-src/transcripts/project-merge.md +++ /dev/null @@ -1,39 +0,0 @@ -# projects merge - -```ucm -.> builtins.merge -``` - -```unison -zonk = 0 -``` - -```ucm -.foo> add -.> project.create-empty foo -.> merge.old foo foo/main -``` - -```unison -bonk = 2 -``` - -```ucm -foo/main> add -``` - -```ucm -.> project.create-empty bar -bar/main> merge.old foo/main -bar/main> branch /topic -``` - -```unison -xonk = 1 -``` - -```ucm -bar/main> add -bar/topic> merge.old /main -.bar> merge.old foo/main -``` diff --git a/unison-src/transcripts/project-merge.output.md b/unison-src/transcripts/project-merge.output.md deleted file mode 100644 index 98f20e79d7..0000000000 --- a/unison-src/transcripts/project-merge.output.md +++ /dev/null @@ -1,193 +0,0 @@ -# projects merge - -```ucm -.> builtins.merge - - Done. - -``` -```unison -zonk = 0 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - zonk : Nat - -``` -```ucm - ☝️ The namespace .foo is empty. - -.foo> add - - ⍟ I've added these definitions: - - zonk : ##Nat - -.> project.create-empty foo - - 🎉 I've created the project foo. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -.> merge.old foo foo/main - - Here's what's changed in foo/main after the merge: - - Added definitions: - - 1. zonk : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -```unison -bonk = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - bonk : Nat - -``` -```ucm -foo/main> add - - ⍟ I've added these definitions: - - bonk : ##Nat - -``` -```ucm -.> project.create-empty bar - - 🎉 I've created the project bar. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -bar/main> merge.old foo/main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. bonk : ##Nat - 2. zonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -bar/main> branch /topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -``` -```unison -xonk = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - xonk : ##Nat - -``` -```ucm -bar/main> add - - ⍟ I've added these definitions: - - xonk : ##Nat - -bar/topic> merge.old /main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. xonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - - ☝️ The namespace .bar is empty. - -.bar> merge.old foo/main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. bonk : ##Nat - 2. zonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` diff --git a/unison-src/transcripts/propagate.md b/unison-src/transcripts/propagate.md index cc80ef885c..19576d8bb8 100644 --- a/unison-src/transcripts/propagate.md +++ b/unison-src/transcripts/propagate.md @@ -1,7 +1,7 @@ # Propagating type edits ```ucm:hide -.subpath.lib> builtins.merge +scratch/main> builtins.merge lib.builtins ``` We introduce a type `Foo` with a function dependent `fooToInt`. @@ -16,9 +16,9 @@ fooToInt _ = +42 And then we add it. ```ucm -.subpath> add -.subpath> find.verbose -.subpath> view fooToInt +scratch/main> add +scratch/main> find.verbose +scratch/main> view fooToInt ``` Then if we change the type `Foo`... @@ -30,13 +30,13 @@ unique type Foo = Foo | Bar and update the codebase to use the new type `Foo`... ```ucm -.subpath> update.old +scratch/main> update.old ``` ... it should automatically propagate the type to `fooToInt`. ```ucm -.subpath> view fooToInt +scratch/main> view fooToInt ``` ### Preserving user type variables @@ -55,7 +55,7 @@ preserve.otherTerm y = someTerm y Add that to the codebase: ```ucm -.subpath> add +scratch/main> add ``` Let's now edit the dependency: @@ -68,58 +68,13 @@ preserve.someTerm _ = None Update... ```ucm -.subpath> update.old +scratch/main> update.old ``` Now the type of `someTerm` should be `Optional x -> Optional x` and the type of `otherTerm` should remain the same. ```ucm -.subpath> view preserve.someTerm -.subpath> view preserve.otherTerm -``` - -### Propagation only applies to the local branch - -Cleaning up a bit... - -```ucm -.> delete.namespace subpath -.subpath.lib> builtins.merge -``` - -Now, we make two terms, where one depends on the other. - -```unison -one.someTerm : Optional foo -> Optional foo -one.someTerm x = x - -one.otherTerm : Optional baz -> Optional baz -one.otherTerm y = someTerm y -``` - -We'll make two copies of this namespace. - -```ucm -.subpath> add -.subpath> fork one two -``` - -Now let's edit one of the terms... - -```unison -someTerm : Optional x -> Optional x -someTerm _ = None -``` - -... in one of the namespaces... - -```ucm -.subpath.one> update.old -``` - -The other namespace should be left alone. - -```ucm -.subpath> view two.someTerm +scratch/main> view preserve.someTerm +scratch/main> view preserve.otherTerm ``` diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md index 5f0b72bb35..d438a96b37 100644 --- a/unison-src/transcripts/propagate.output.md +++ b/unison-src/transcripts/propagate.output.md @@ -2,14 +2,14 @@ We introduce a type `Foo` with a function dependent `fooToInt`. -```unison +``` unison unique type Foo = Foo fooToInt : Foo -> Int fooToInt _ = +42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,15 +25,15 @@ fooToInt _ = +42 ``` And then we add it. -```ucm -.subpath> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo fooToInt : Foo -> Int -.subpath> find.verbose +scratch/main> find.verbose 1. -- #uj8oalgadr2f52qloufah6t8vsvbc76oqijkotek87vooih7aqu44k20hrs34kartusapghp4jmfv6g1409peklv3r6a527qpk52soo type Foo @@ -46,7 +46,7 @@ And then we add it. -.subpath> view fooToInt +scratch/main> view fooToInt fooToInt : Foo -> Int fooToInt _ = +42 @@ -54,11 +54,11 @@ And then we add it. ``` Then if we change the type `Foo`... -```unison +``` unison unique type Foo = Foo | Bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -74,8 +74,8 @@ unique type Foo = Foo | Bar ``` and update the codebase to use the new type `Foo`... -```ucm -.subpath> update.old +``` ucm +scratch/main> update.old ⍟ I've updated these names to your new definition: @@ -84,8 +84,8 @@ and update the codebase to use the new type `Foo`... ``` ... it should automatically propagate the type to `fooToInt`. -```ucm -.subpath> view fooToInt +``` ucm +scratch/main> view fooToInt fooToInt : Foo -> Int fooToInt _ = +42 @@ -96,7 +96,7 @@ and update the codebase to use the new type `Foo`... We make a term that has a dependency on another term and also a non-redundant user-provided type signature. -```unison +``` unison preserve.someTerm : Optional foo -> Optional foo preserve.someTerm x = x @@ -104,7 +104,7 @@ preserve.otherTerm : Optional baz -> Optional baz preserve.otherTerm y = someTerm y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -120,8 +120,8 @@ preserve.otherTerm y = someTerm y ``` Add that to the codebase: -```ucm -.subpath> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -131,12 +131,12 @@ Add that to the codebase: ``` Let's now edit the dependency: -```unison +``` unison preserve.someTerm : Optional x -> Optional x preserve.someTerm _ = None ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -152,8 +152,8 @@ preserve.someTerm _ = None ``` Update... -```ucm -.subpath> update.old +``` ucm +scratch/main> update.old ⍟ I've updated these names to your new definition: @@ -163,109 +163,15 @@ Update... Now the type of `someTerm` should be `Optional x -> Optional x` and the type of `otherTerm` should remain the same. -```ucm -.subpath> view preserve.someTerm +``` ucm +scratch/main> view preserve.someTerm preserve.someTerm : Optional x -> Optional x preserve.someTerm _ = None -.subpath> view preserve.otherTerm +scratch/main> view preserve.otherTerm preserve.otherTerm : Optional baz -> Optional baz preserve.otherTerm y = someTerm y ``` -### Propagation only applies to the local branch - -Cleaning up a bit... - -```ucm -.> delete.namespace subpath - - Done. - - ☝️ The namespace .subpath.lib is empty. - -.subpath.lib> builtins.merge - - Done. - -``` -Now, we make two terms, where one depends on the other. - -```unison -one.someTerm : Optional foo -> Optional foo -one.someTerm x = x - -one.otherTerm : Optional baz -> Optional baz -one.otherTerm y = someTerm y -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo - -``` -We'll make two copies of this namespace. - -```ucm -.subpath> add - - ⍟ I've added these definitions: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo - -.subpath> fork one two - - Done. - -``` -Now let's edit one of the terms... - -```unison -someTerm : Optional x -> Optional x -someTerm _ = None -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - someTerm : Optional x -> Optional x - -``` -... in one of the namespaces... - -```ucm -.subpath.one> update.old - - ⍟ I've updated these names to your new definition: - - someTerm : #nirp5os0q6 x -> #nirp5os0q6 x - -``` -The other namespace should be left alone. - -```ucm -.subpath> view two.someTerm - - two.someTerm : Optional foo -> Optional foo - two.someTerm x = x - -``` diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index a2894f6468..38afde71c9 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm test/main> pull @aryairani/test-almost-empty/main lib.base_latest The use of `pull` to install libraries is now deprecated. @@ -12,27 +12,32 @@ test/main> pull @aryairani/test-almost-empty/main lib.base_latest test/main> pull @aryairani/test-almost-empty/main a.b - I think you're wanting to merge - @aryairani/test-almost-empty/main into the a.b namespace, but - the `pull` command only supports merging into the top level of - a local project branch. - - Use `help pull` to see some examples. +⚠️ + +Sorry, I wasn’t sure how to process your request: + + I think you want to merge @aryairani/test-almost-empty/main + into the a.b namespace, but the `pull` command only supports + merging into the top level of a local project branch. + +You can run `help pull` for more information on using `pull`. test/main> pull @aryairani/test-almost-empty/main a - I think you're wanting to merge - @aryairani/test-almost-empty/main into the a branch, but it - doesn't exist. If you want, you can create it with - `branch.empty a`, and then `pull` again. + I think you want to merge @aryairani/test-almost-empty/main + into the a branch, but it doesn't exist. If you want, you can + create it with `branch.empty a`, and then `pull` again. test/main> pull @aryairani/test-almost-empty/main .a - I think you're wanting to merge - @aryairani/test-almost-empty/main into the .a namespace, but - the `pull` command only supports merging into the top level of - a local project branch. - - Use `help pull` to see some examples. +⚠️ + +Sorry, I wasn’t sure how to process your request: + + I think you want to merge @aryairani/test-almost-empty/main + into the .a namespace, but the `pull` command only supports + merging into the top level of a local project branch. + +You can run `help pull` for more information on using `pull`. ``` diff --git a/unison-src/transcripts/records.md b/unison-src/transcripts/records.md index 4a3d5d23d2..199218f3ea 100644 --- a/unison-src/transcripts/records.md +++ b/unison-src/transcripts/records.md @@ -1,8 +1,8 @@ Ensure that Records keep their syntax after being added to the codebase ```ucm:hide -.> builtins.merge -.> load unison-src/transcripts-using-base/base.u +scratch/main> builtins.merge +scratch/main> load unison-src/transcripts-using-base/base.u ``` ## Record with 1 field @@ -12,11 +12,11 @@ unique type Record1 = { a : Text } ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record1 +scratch/main> view Record1 ``` ## Record with 2 fields @@ -26,11 +26,11 @@ unique type Record2 = { a : Text, b : Int } ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record2 +scratch/main> view Record2 ``` ## Record with 3 fields @@ -40,11 +40,11 @@ unique type Record3 = { a : Text, b : Int, c : Nat } ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record3 +scratch/main> view Record3 ``` ## Record with many fields @@ -62,11 +62,11 @@ unique type Record4 = ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record4 +scratch/main> view Record4 ``` ## Record with many many fields @@ -98,11 +98,11 @@ unique type Record5 = { ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record5 +scratch/main> view Record5 ``` ## Record with user-defined type fields @@ -116,13 +116,13 @@ unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } ``` ```ucm:hide -.> add +scratch/main> add ``` If you `view` or `edit` it, it _should_ be treated as a record type, but it does not (which is a bug) ```ucm -.> view RecordWithUserType +scratch/main> view RecordWithUserType ``` diff --git a/unison-src/transcripts/records.output.md b/unison-src/transcripts/records.output.md index 064e18c690..3e3d66245c 100644 --- a/unison-src/transcripts/records.output.md +++ b/unison-src/transcripts/records.output.md @@ -2,43 +2,43 @@ Ensure that Records keep their syntax after being added to the codebase ## Record with 1 field -```unison +``` unison unique type Record1 = { a : Text } ``` -```ucm -.> view Record1 +``` ucm +scratch/main> view Record1 type Record1 = { a : Text } ``` ## Record with 2 fields -```unison +``` unison unique type Record2 = { a : Text, b : Int } ``` -```ucm -.> view Record2 +``` ucm +scratch/main> view Record2 type Record2 = { a : Text, b : Int } ``` ## Record with 3 fields -```unison +``` unison unique type Record3 = { a : Text, b : Int, c : Nat } ``` -```ucm -.> view Record3 +``` ucm +scratch/main> view Record3 type Record3 = { a : Text, b : Int, c : Nat } ``` ## Record with many fields -```unison +``` unison unique type Record4 = { a : Text , b : Int @@ -50,8 +50,8 @@ unique type Record4 = } ``` -```ucm -.> view Record4 +``` ucm +scratch/main> view Record4 type Record4 = { a : Text, @@ -65,7 +65,7 @@ unique type Record4 = ``` ## Record with many many fields -```unison +``` unison unique type Record5 = { zero : Nat, one : [Nat], @@ -91,8 +91,8 @@ unique type Record5 = { } ``` -```ucm -.> view Record5 +``` ucm +scratch/main> view Record5 type Record5 = { zero : Nat, @@ -122,16 +122,16 @@ unique type Record5 = { This record type has two fields whose types are user-defined (`Record4` and `UserType`). -```unison +``` unison unique type UserType = UserType Nat unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } ``` -If you `view` or `edit` it, it _should_ be treated as a record type, but it does not (which is a bug) +If you `view` or `edit` it, it *should* be treated as a record type, but it does not (which is a bug) -```ucm -.> view RecordWithUserType +``` ucm +scratch/main> view RecordWithUserType type RecordWithUserType = { a : Text, b : Record4, c : UserType } @@ -141,14 +141,14 @@ If you `view` or `edit` it, it _should_ be treated as a record type, but it does Trailing commas are allowed. -```unison +``` unison unique type Record5 = { a : Text, b : Int, } ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md index 202dc50820..0bbb4f57df 100644 --- a/unison-src/transcripts/reflog.md +++ b/unison-src/transcripts/reflog.md @@ -1,31 +1,41 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge lib.builtins ``` -First we make two changes to the codebase, so that there's more than one line -for the `reflog` command to display: +First we make some changes to the codebase so there's data in the reflog. ```unison x = 1 ``` ```ucm -.> add +scratch/main> add ``` ```unison y = 2 ``` ```ucm -.> add -.> view y +scratch/main> add +scratch/main> branch /other +scratch/other> alias.term y z +newproject/main> builtins.merge lib.builtins +newproject/main> alias.type lib.builtins.Nat MyNat ``` + +Should see reflog entries from the current branch + ```ucm -.> reflog +scratch/main> reflog ``` -If we `reset-root` to its previous value, `y` disappears. +Should see reflog entries from the current project + ```ucm -.> reset-root 2 +scratch/main> project.reflog ``` -```ucm:error -.> view y + + +Should see reflog entries from all projects + +```ucm +scratch/main> reflog.global ``` diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 96e68114ff..9fbff90318 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -1,11 +1,10 @@ -First we make two changes to the codebase, so that there's more than one line -for the `reflog` command to display: +First we make some changes to the codebase so there's data in the reflog. -```unison +``` unison x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,19 +17,19 @@ x = 1 x : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: x : Nat ``` -```unison +``` unison y = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -43,56 +42,94 @@ y = 2 y : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: y : Nat -.> view y +scratch/main> branch /other - y : Nat - y = 2 + Done. I've created the other branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /other`. + +scratch/other> alias.term y z + + Done. + +newproject/main> builtins.merge lib.builtins + + Done. + +newproject/main> alias.type lib.builtins.Nat MyNat + + Done. ``` -```ucm -.> reflog +Should see reflog entries from the current branch - Here is a log of the root namespace hashes, starting with the - most recent, along with the command that got us there. Try: - - `fork 2 .old` - `fork #p611n6o5ve .old` to make an old namespace - accessible again, - - `reset-root #p611n6o5ve` to reset the root namespace and - its history to that of the - specified namespace. +``` ucm +scratch/main> reflog + + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. - When Root Hash Action - 1. now #rmu2vgm86a add - 2. now #p611n6o5ve add - 3. now #4bigcpnl7t builtins.merge - 4. #sg60bvjo91 history starts here + Tip: Use `diff.namespace 1 7` to compare between points in + history. - Tip: Use `diff.namespace 1 7` to compare namespaces between - two points in history. + Branch Hash Description + 1. scratch/main #6mdl5gruh5 add + 2. scratch/main #3rqf1hbev7 add + 3. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins + 4. scratch/main #sg60bvjo91 Project Created ``` -If we `reset-root` to its previous value, `y` disappears. -```ucm -.> reset-root 2 +Should see reflog entries from the current project - Done. +``` ucm +scratch/main> project.reflog + + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch Hash Description + 1. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z + 2. scratch/other #6mdl5gruh5 Branch created from scratch/main + 3. scratch/main #6mdl5gruh5 add + 4. scratch/main #3rqf1hbev7 add + 5. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins + 6. scratch/main #sg60bvjo91 Project Created ``` -```ucm -.> view y +Should see reflog entries from all projects - ⚠️ +``` ucm +scratch/main> reflog.global + + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. - The following names were not found in the codebase. Check your spelling. - y + Branch Hash Description + 1. newproject/main #2rjhs2vq43 alias.term newproject/main:lib.builtins.Nat newproject/main:... + 2. newproject/main #ms9lggs2rg builtins.merge newproject/main:lib.builtins + 3. newproject/main #sg60bvjo91 Branch Created + 4. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z + 5. scratch/other #6mdl5gruh5 Branch created from scratch/main + 6. scratch/main #6mdl5gruh5 add + 7. scratch/main #3rqf1hbev7 add + 8. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins + 9. scratch/main #sg60bvjo91 Project Created ``` diff --git a/unison-src/transcripts/release-draft-command.output.md b/unison-src/transcripts/release-draft-command.output.md index 0eb667e870..3354e764f9 100644 --- a/unison-src/transcripts/release-draft-command.output.md +++ b/unison-src/transcripts/release-draft-command.output.md @@ -2,11 +2,11 @@ The `release.draft` command drafts a release from the current branch. Some setup: -```unison +``` unison someterm = 18 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ someterm = 18 someterm : Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ Now, the `release.draft` demo: `release.draft` accepts a single semver argument. -```ucm +``` ucm foo/main> release.draft 1.2.3 😎 Great! I've created a draft release for you at @@ -51,7 +51,7 @@ foo/main> release.draft 1.2.3 ``` It's an error to try to create a `releases/drafts/x.y.z` branch that already exists. -```ucm +``` ucm foo/main> release.draft 1.2.3 foo/releases/drafts/1.2.3 already exists. You can switch to it diff --git a/unison-src/transcripts/reset.md b/unison-src/transcripts/reset.md index a01351233d..e430ef2906 100644 --- a/unison-src/transcripts/reset.md +++ b/unison-src/transcripts/reset.md @@ -1,78 +1,63 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` -# reset loose code ```unison -a = 5 +def = "first value" ``` -```ucm -.> add -.> history -.> reset 2 -.> history +```ucm:hide +scratch/main> update ``` -```unison -foo.a = 5 +```unison:hide +def = "second value" ``` +Can reset to a value from history by number. + ```ucm -.> add -.> ls foo -.> history -.> reset 1 foo -.> ls foo.foo +scratch/main> update +scratch/main> history +scratch/main> reset 2 +scratch/main> view def +scratch/main> history ``` -# reset branch +Can reset to a value from reflog by number. ```ucm -foo/main> history +scratch/main> reflog +-- Reset the current branch to the first history element +scratch/main> reset 2 +scratch/main> view def +scratch/main> history ``` -```unison -a = 5 -``` +# reset branch ```ucm -foo/main> add -foo/main> branch topic foo/main> history ``` -```unison -a = 3 +```unison:hide +a = 5 ``` ```ucm foo/main> update -foo/main> reset /topic -foo/main> history +foo/empty> reset /main: +foo/empty> view a +foo/empty> history ``` -# ambiguous reset - -## ambiguous target -```unison +## second argument is always interpreted as a branch +```unison:hide main.a = 3 ``` -```ucm:error -foo/main> add +```ucm +foo/main> update foo/main> history foo/main> reset 2 main ``` - -## ambiguous hash - -```unison -main.a = 3 -``` - -```ucm:error -foo/main> switch /topic -foo/topic> add -foo/topic> reset main -``` diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 344b2c16f9..7bcdacc4a1 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -1,9 +1,8 @@ -# reset loose code -```unison -a = 5 +``` unison +def = "first value" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -13,132 +12,117 @@ a = 5 ⍟ These new definitions are ok to `add`: - a : Nat + def : Text ``` -```ucm -.> add +``` unison +def = "second value" +``` - ⍟ I've added these definitions: - - a : Nat +Can reset to a value from history by number. + +``` ucm +scratch/main> update -.> history + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> history Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #d079vet1oj + ⊙ 1. #5vq851j3hg + Adds / updates: - a + def - □ 2. #4bigcpnl7t (start of history) + ⊙ 2. #ujvq6e87kp + + + Adds / updates: + + def + + □ 3. #4bigcpnl7t (start of history) -.> reset 2 +scratch/main> reset 2 Done. -.> history +scratch/main> view def + + def : Text + def = "first value" + +scratch/main> history Note: The most recent namespace hash is immediately below this message. + ⊙ 1. #ujvq6e87kp + + Adds / updates: + + def - □ 1. #4bigcpnl7t (start of history) + □ 2. #4bigcpnl7t (start of history) ``` -```unison -foo.a = 5 -``` - -```ucm +Can reset to a value from reflog by number. - Loading changes detected in scratch.u. +``` ucm +scratch/main> reflog - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. - ⍟ These new definitions are ok to `add`: - - foo.a : Nat + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch Hash Description + 1. scratch/main #ujvq6e87kp reset ujvq6e87kp4288eq3al9v5luctic0ocd7ug1fu0go5bicrr2vfnrb0... + 2. scratch/main #5vq851j3hg update + 3. scratch/main #ujvq6e87kp update + 4. scratch/main #4bigcpnl7t builtins.merge + 5. scratch/main #sg60bvjo91 Project Created -``` -```ucm -.> add +-- Reset the current branch to the first history element +scratch/main> reset 2 - ⍟ I've added these definitions: - - foo.a : Nat + Done. -.> ls foo +scratch/main> view def - 1. a (Nat) + def : Text + def = "second value" -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #tfg7r9359n + ⊙ 1. #5vq851j3hg + Adds / updates: - foo.a + def - □ 2. #4bigcpnl7t (start of history) - -.> reset 1 foo - - Done. - -.> ls foo.foo - - 1. a (Nat) - -``` -# reset branch - -```ucm -foo/main> history - - ☝️ The namespace is empty. - -``` -```unison -a = 5 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: + ⊙ 2. #ujvq6e87kp - ⍟ These new definitions are ok to `add`: + + Adds / updates: - a : ##Nat - -``` -```ucm -foo/main> add - - ⍟ I've added these definitions: + def - a : ##Nat + □ 3. #4bigcpnl7t (start of history) -foo/main> branch topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. +``` +# reset branch +``` ucm foo/main> history Note: The most recent namespace hash is immediately below this @@ -146,28 +130,14 @@ foo/main> history - □ 1. #5l94rduvel (start of history) + □ 1. #sg60bvjo91 (start of history) ``` -```unison -a = 3 +``` unison +a = 5 ``` -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - a : ##Nat - -``` -```ucm +``` ucm foo/main> update Okay, I'm searching the branch for code that needs to be @@ -175,11 +145,16 @@ foo/main> update Done. -foo/main> reset /topic +foo/empty> reset /main: Done. -foo/main> history +foo/empty> view a + + a : ##Nat + a = 5 + +foo/empty> history Note: The most recent namespace hash is immediately below this message. @@ -189,32 +164,19 @@ foo/main> history □ 1. #5l94rduvel (start of history) ``` -# ambiguous reset +## second argument is always interpreted as a branch -## ambiguous target -```unison +``` unison main.a = 3 ``` -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - main.a : ##Nat +``` ucm +foo/main> update -``` -```ucm -foo/main> add + Okay, I'm searching the branch for code that needs to be + updated... - ⍟ I've added these definitions: - - main.a : ##Nat + Done. foo/main> history @@ -231,49 +193,6 @@ foo/main> history foo/main> reset 2 main - I'm not sure if you wanted to reset the branch foo/main or the - namespace main in the current branch. Could you be more - specific? - - 1. /main (the branch main in the current project) - 2. main (the relative path main in the current branch) - - Tip: use `reset 1` or `reset 2` to - pick one of these. - -``` -## ambiguous hash - -```unison -main.a = 3 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -```ucm -foo/main> switch /topic - -foo/topic> add - - ⍟ I've added these definitions: - - main.a : ##Nat - -foo/topic> reset main - - I'm not sure if you wanted to reset to the branch foo/main or - to the namespace main in the current branch. Could you be more - specific? - - 1. /main (the branch main in the current project) - 2. main (the relative path main in the current branch) - - Tip: use `reset 1` or `reset 2` to pick one of these. + Done. ``` diff --git a/unison-src/transcripts/resolution-failures.md b/unison-src/transcripts/resolution-failures.md index f6f0b0a4ad..b9b97c999e 100644 --- a/unison-src/transcripts/resolution-failures.md +++ b/unison-src/transcripts/resolution-failures.md @@ -4,6 +4,10 @@ This transcript tests the errors printed to the user when a name cannot be resol ## Codebase Setup +```ucm +scratch/main> builtins.merge lib.builtins +``` + First we define differing types with the same name in different namespaces: ```unison @@ -15,7 +19,7 @@ two.ambiguousTerm = "term two" ``` ```ucm -.example.resolution_failures> add +scratch/main> add ``` ## Tests diff --git a/unison-src/transcripts/resolution-failures.output.md b/unison-src/transcripts/resolution-failures.output.md index 352e2f1c20..c4aaf98906 100644 --- a/unison-src/transcripts/resolution-failures.output.md +++ b/unison-src/transcripts/resolution-failures.output.md @@ -4,9 +4,15 @@ This transcript tests the errors printed to the user when a name cannot be resol ## Codebase Setup +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +``` First we define differing types with the same name in different namespaces: -```unison +``` unison unique type one.AmbiguousType = one.AmbiguousType unique type two.AmbiguousType = two.AmbiguousType @@ -14,7 +20,7 @@ one.ambiguousTerm = "term one" two.ambiguousTerm = "term two" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,21 +32,19 @@ two.ambiguousTerm = "term two" type one.AmbiguousType type two.AmbiguousType - one.ambiguousTerm : ##Text - two.ambiguousTerm : ##Text + one.ambiguousTerm : Text + two.ambiguousTerm : Text ``` -```ucm - ☝️ The namespace .example.resolution_failures is empty. - -.example.resolution_failures> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type one.AmbiguousType type two.AmbiguousType - one.ambiguousTerm : ##Text - two.ambiguousTerm : ##Text + one.ambiguousTerm : Text + two.ambiguousTerm : Text ``` ## Tests @@ -50,10 +54,10 @@ It is ambiguous which type from which namespace we mean. We expect the output to: -1. Print all ambiguous usage sites separately -2. Print possible disambiguation suggestions for each unique ambiguity +1. Print all ambiguous usage sites separately +2. Print possible disambiguation suggestions for each unique ambiguity -```unison +``` unison -- We intentionally avoid using a constructor to ensure the constructor doesn't -- affect type resolution. useAmbiguousType : AmbiguousType -> () @@ -67,7 +71,7 @@ separateAmbiguousTypeUsage : AmbiguousType -> () separateAmbiguousTypeUsage _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -98,11 +102,11 @@ separateAmbiguousTypeUsage _ = () Currently, ambiguous terms are caught and handled by type directed name resolution, but expect it to eventually be handled by the above machinery. -```unison +``` unison useAmbiguousTerm = ambiguousTerm ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -116,7 +120,7 @@ useAmbiguousTerm = ambiguousTerm I found some terms in scope that have matching names and types. Maybe you meant one of these: - one.ambiguousTerm : ##Text - two.ambiguousTerm : ##Text + one.ambiguousTerm : Text + two.ambiguousTerm : Text ``` diff --git a/unison-src/transcripts/rsa.md b/unison-src/transcripts/rsa.md index 6b9ed33b53..6fe2118370 100644 --- a/unison-src/transcripts/rsa.md +++ b/unison-src/transcripts/rsa.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/rsa.output.md b/unison-src/transcripts/rsa.output.md index b81a16becc..98e735c2ed 100644 --- a/unison-src/transcripts/rsa.output.md +++ b/unison-src/transcripts/rsa.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison up = 0xs0123456789abcdef down = 0xsfedcba9876543210 @@ -31,7 +30,7 @@ sigKo = match signature with > sigKo ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/scope-ref.md b/unison-src/transcripts/scope-ref.md index 67fcbc336b..1abf26be2f 100644 --- a/unison-src/transcripts/scope-ref.md +++ b/unison-src/transcripts/scope-ref.md @@ -2,7 +2,7 @@ A short script to test mutable references with local scope. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/scope-ref.output.md b/unison-src/transcripts/scope-ref.output.md index ea44a79469..c356bc531d 100644 --- a/unison-src/transcripts/scope-ref.output.md +++ b/unison-src/transcripts/scope-ref.output.md @@ -1,7 +1,6 @@ - A short script to test mutable references with local scope. -```unison +``` unison test = Scope.run 'let r = Scope.ref 0 Ref.write r 1 @@ -14,7 +13,7 @@ test = Scope.run 'let > test ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/squash.md b/unison-src/transcripts/squash.md deleted file mode 100644 index f3b010944a..0000000000 --- a/unison-src/transcripts/squash.md +++ /dev/null @@ -1,157 +0,0 @@ - -```ucm:hide -.> builtins.merge -``` - -# Squash merges - -`squash src dest` merges can be used to merge from `src` to `dest`, discarding the history of `src`. It's useful when the source namespace history is irrelevant or has a bunch of churn you wish to discard. Often when merging small pull requests, you'll use a squash merge. - -Let's look at some examples. We'll start with a namespace with just the builtins. Let's take a look at the hash of this namespace: - -```ucm -.> history builtin -.> fork builtin builtin2 -``` - -(We make a copy of `builtin` for use later in this transcript.) - -Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, then rename it back. Notice this produces multiple entries in the history: - -```ucm -.> fork builtin mybuiltin -.mybuiltin> rename.term Nat.+ Nat.frobnicate -.mybuiltin> rename.term Nat.frobnicate Nat.+ -.mybuiltin> history -``` - -If we merge that back into `builtin`, we get that same chain of history: - -```ucm -.> merge.old mybuiltin builtin -.> history builtin -``` - -Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged: - -```ucm -.> merge.old.squash mybuiltin builtin2 -.> history builtin2 -``` - -The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect. - -## Another example - -Let's look at a more interesting example, where the two namespaces have diverged a bit. Here's our starting namespace: - -```unison:hide -x = 1 -``` - -```ucm -.trunk> add -.> fork trunk alice -.> fork trunk bob -``` - -Alice now does some hacking: - -```unison:hide -radNumber = 348 -bodaciousNumero = 2394 -neatoFun x = x -``` - -```ucm -.alice> add -.alice> rename.term radNumber superRadNumber -.alice> rename.term neatoFun productionReadyId -``` - -Meanwhile, Bob does his own hacking: - -```unison:hide -whatIsLove = "?" -babyDon'tHurtMe = ".. Don't hurt me..." -no more = no more -``` - -```ucm -.bob> add -``` - -At this point, Alice and Bob both have some history beyond what's in trunk: - -```ucm -.> history trunk -.> history alice -.> history bob -``` - -Alice then squash merges into `trunk`, as does Bob. It's as if Alice and Bob both made their changes in one single commit. - -```ucm -.> merge.old.squash alice trunk -.> history trunk -.> merge.old.squash bob trunk -.> history trunk -``` - -Since squash merges don't produce any merge nodes, we can `undo` a couple times to get back to our starting state: - -```ucm -.> undo -.> undo -.> history trunk -``` - -This time, we'll first squash Alice and Bob's changes together before squashing their combined changes into `trunk`. The resulting `trunk` will have just a single entry in it, combining both Alice and Bob's changes: - -```ucm -.> merge.old.squash alice bob -.> merge.old.squash bob trunk -.> history trunk -``` - -So, there you have it. With squashing, you can control the granularity of your history. - -## Throwing out all history - -Another thing we can do is `squash` into an empty namespace. This effectively makes a copy of the namespace, but without any of its history: - -```ucm -.> merge.old.squash alice nohistoryalice -.> history nohistoryalice -``` - -There's nothing really special here, `squash src dest` discards `src` history that comes after the LCA of `src` and `dest`, it's just that in the case of an empty namespace, that LCA is the beginning of time (the empty namespace), so all the history of `src` is discarded. - -## Checking for handling of deletes - -This checks to see that squashing correctly preserves deletions: - -```ucm -.delete> builtins.merge -.delete> fork builtin builtin2 -.delete> delete.term.verbose builtin2.Nat.+ -.delete> delete.term.verbose builtin2.Nat.* -.delete> merge.old.squash builtin2 builtin -.delete> history builtin -``` - -Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them deleted in one atomic step in the history. - -Just confirming that those two definitions are in fact removed: - -```ucm:error -.delete> view .delete.builtin.Nat.+ -``` - -```ucm:error -.delete> view .delete.builtin.Nat.* -``` - -## Caveats - -If you `squash mystuff trunk`, you're discarding any history of `mystuff` and just cons'ing onto the history of `trunk`. Thus, don't expect to be able to `merge trunk mystuff` later and get great results. Squashing should only be used when you don't care about the history (and you know others haven't pulled and built on your line of history being discarded, so they don't care about the history either). diff --git a/unison-src/transcripts/squash.output.md b/unison-src/transcripts/squash.output.md deleted file mode 100644 index 3698fdfe6a..0000000000 --- a/unison-src/transcripts/squash.output.md +++ /dev/null @@ -1,529 +0,0 @@ - -# Squash merges - -`squash src dest` merges can be used to merge from `src` to `dest`, discarding the history of `src`. It's useful when the source namespace history is irrelevant or has a bunch of churn you wish to discard. Often when merging small pull requests, you'll use a squash merge. - -Let's look at some examples. We'll start with a namespace with just the builtins. Let's take a look at the hash of this namespace: - -```ucm -.> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i3vp9o9btm (start of history) - -.> fork builtin builtin2 - - Done. - -``` -(We make a copy of `builtin` for use later in this transcript.) - -Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, then rename it back. Notice this produces multiple entries in the history: - -```ucm -.> fork builtin mybuiltin - - Done. - -.mybuiltin> rename.term Nat.+ Nat.frobnicate - - Done. - -.mybuiltin> rename.term Nat.frobnicate Nat.+ - - Done. - -.mybuiltin> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #tpkjb488ei - - > Moves: - - Original name New name - Nat.frobnicate Nat.+ - - ⊙ 2. #334ak3epqt - - > Moves: - - Original name New name - Nat.+ Nat.frobnicate - - □ 3. #i3vp9o9btm (start of history) - -``` -If we merge that back into `builtin`, we get that same chain of history: - -```ucm -.> merge.old mybuiltin builtin - - Nothing changed as a result of the merge. - - Applying changes from patch... - -.> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #tpkjb488ei - - > Moves: - - Original name New name - Nat.frobnicate Nat.+ - - ⊙ 2. #334ak3epqt - - > Moves: - - Original name New name - Nat.+ Nat.frobnicate - - □ 3. #i3vp9o9btm (start of history) - -``` -Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged: - -```ucm -.> merge.old.squash mybuiltin builtin2 - - Nothing changed as a result of the merge. - - 😶 - - builtin2 was already up-to-date with mybuiltin. - -.> history builtin2 - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i3vp9o9btm (start of history) - -``` -The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect. - -## Another example - -Let's look at a more interesting example, where the two namespaces have diverged a bit. Here's our starting namespace: - -```unison -x = 1 -``` - -```ucm - ☝️ The namespace .trunk is empty. - -.trunk> add - - ⍟ I've added these definitions: - - x : ##Nat - -.> fork trunk alice - - Done. - -.> fork trunk bob - - Done. - -``` -Alice now does some hacking: - -```unison -radNumber = 348 -bodaciousNumero = 2394 -neatoFun x = x -``` - -```ucm -.alice> add - - ⍟ I've added these definitions: - - bodaciousNumero : ##Nat - neatoFun : x -> x - radNumber : ##Nat - -.alice> rename.term radNumber superRadNumber - - Done. - -.alice> rename.term neatoFun productionReadyId - - Done. - -``` -Meanwhile, Bob does his own hacking: - -```unison -whatIsLove = "?" -babyDon'tHurtMe = ".. Don't hurt me..." -no more = no more -``` - -```ucm -.bob> add - - ⍟ I've added these definitions: - - babyDon'tHurtMe : ##Text - no : more -> r - whatIsLove : ##Text - -``` -At this point, Alice and Bob both have some history beyond what's in trunk: - -```ucm -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i52j9fd57b (start of history) - -.> history alice - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #e9jd55555o - - > Moves: - - Original name New name - neatoFun productionReadyId - - ⊙ 2. #l5ocoo2eac - - > Moves: - - Original name New name - radNumber superRadNumber - - ⊙ 3. #i1vq05628n - - + Adds / updates: - - bodaciousNumero neatoFun radNumber - - □ 4. #i52j9fd57b (start of history) - -.> history bob - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #brr4400742 - - + Adds / updates: - - babyDon'tHurtMe no whatIsLove - - □ 2. #i52j9fd57b (start of history) - -``` -Alice then squash merges into `trunk`, as does Bob. It's as if Alice and Bob both made their changes in one single commit. - -```ucm -.> merge.old.squash alice trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #f9lvm9gd2k - - + Adds / updates: - - bodaciousNumero productionReadyId superRadNumber - - □ 2. #i52j9fd57b (start of history) - -.> merge.old.squash bob trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. babyDon'tHurtMe : Text - 2. no : more -> r - 3. whatIsLove : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #dbp78ts6q3 - - + Adds / updates: - - babyDon'tHurtMe no whatIsLove - - ⊙ 2. #f9lvm9gd2k - - + Adds / updates: - - bodaciousNumero productionReadyId superRadNumber - - □ 3. #i52j9fd57b (start of history) - -``` -Since squash merges don't produce any merge nodes, we can `undo` a couple times to get back to our starting state: - -```ucm -.> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. bob.babyDon'tHurtMe 2. trunk.babyDon'tHurtMe (added) - - 3. bob.no 4. trunk.no (added) - - 5. bob.whatIsLove 6. trunk.whatIsLove (added) - -.> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. alice.bodaciousNumero 2. trunk.bodaciousNumero (added) - - 3. alice.productionReadyId 4. trunk.productionReadyId (added) - - 5. alice.superRadNumber 6. trunk.superRadNumber (added) - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i52j9fd57b (start of history) - -``` -This time, we'll first squash Alice and Bob's changes together before squashing their combined changes into `trunk`. The resulting `trunk` will have just a single entry in it, combining both Alice and Bob's changes: - -```ucm -.> merge.old.squash alice bob - - Here's what's changed in bob after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash bob trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. babyDon'tHurtMe : Text - 2. bodaciousNumero : Nat - 3. no : more -> r - 4. productionReadyId : x -> x - 5. superRadNumber : Nat - 6. whatIsLove : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #qtotqgds4i - - + Adds / updates: - - babyDon'tHurtMe bodaciousNumero no productionReadyId - superRadNumber whatIsLove - - □ 2. #i52j9fd57b (start of history) - -``` -So, there you have it. With squashing, you can control the granularity of your history. - -## Throwing out all history - -Another thing we can do is `squash` into an empty namespace. This effectively makes a copy of the namespace, but without any of its history: - -```ucm -.> merge.old.squash alice nohistoryalice - - Here's what's changed in nohistoryalice after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - 4. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history nohistoryalice - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #1d9haupn3d (start of history) - -``` -There's nothing really special here, `squash src dest` discards `src` history that comes after the LCA of `src` and `dest`, it's just that in the case of an empty namespace, that LCA is the beginning of time (the empty namespace), so all the history of `src` is discarded. - -## Checking for handling of deletes - -This checks to see that squashing correctly preserves deletions: - -```ucm - ☝️ The namespace .delete is empty. - -.delete> builtins.merge - - Done. - -.delete> fork builtin builtin2 - - Done. - -.delete> delete.term.verbose builtin2.Nat.+ - - Name changes: - - Original Changes - 1. builtin.Nat.+ ┐ 2. builtin2.Nat.+ (removed) - 3. builtin2.Nat.+ ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.delete> delete.term.verbose builtin2.Nat.* - - Name changes: - - Original Changes - 1. builtin.Nat.* ┐ 2. builtin2.Nat.* (removed) - 3. builtin2.Nat.* ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.delete> merge.old.squash builtin2 builtin - - Here's what's changed in builtin after the merge: - - Removed definitions: - - 1. Nat.* : Nat -> Nat -> Nat - 2. Nat.+ : Nat -> Nat -> Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.delete> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #dv00hf6vmg - - - Deletes: - - Nat.* Nat.+ - - □ 2. #i3vp9o9btm (start of history) - -``` -Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them deleted in one atomic step in the history. - -Just confirming that those two definitions are in fact removed: - -```ucm -.delete> view .delete.builtin.Nat.+ - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - .delete.builtin.Nat.+ - -``` -```ucm -.delete> view .delete.builtin.Nat.* - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - .delete.builtin.Nat.* - -``` -## Caveats - -If you `squash mystuff trunk`, you're discarding any history of `mystuff` and just cons'ing onto the history of `trunk`. Thus, don't expect to be able to `merge trunk mystuff later and get great results. Squashing should only be used when you don't care about the history (and you know others haven't pulled and built on your line of history being discarded, so they don't care about the history either). diff --git a/unison-src/transcripts/suffixes.md b/unison-src/transcripts/suffixes.md index 3a4c47933f..7245b4cb31 100644 --- a/unison-src/transcripts/suffixes.md +++ b/unison-src/transcripts/suffixes.md @@ -1,7 +1,7 @@ # Suffix-based resolution of names ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Any unique name suffix can be used to refer to a definition. For instance: @@ -20,15 +20,15 @@ optional.isNone = cases This also affects commands like find. Notice lack of qualified names in output: ```ucm -.> add -.> find take +scratch/main> add +scratch/main> find take ``` The `view` and `display` commands also benefit from this: ```ucm -.> view List.drop -.> display bar.a +scratch/main> view List.drop +scratch/main> display bar.a ``` In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name is still shown for each search result though. @@ -36,7 +36,7 @@ In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: ```ucm -.> find : Nat -> [a] -> [a] +scratch/main> find : Nat -> [a] -> [a] ``` ## Preferring names not in `lib.*.lib.*` @@ -51,7 +51,7 @@ lib.distributed.lib.baz.qux = "indirect dependency" ``` ```ucm -.> add +scratch/main> add ``` ```unison:error @@ -63,15 +63,15 @@ lib.distributed.lib.baz.qux = "indirect dependency" ``` ```ucm -.> view abra.cadabra -.> view baz.qux +scratch/main> view abra.cadabra +scratch/main> view baz.qux ``` Note that we can always still view indirect dependencies by using more name segments: ```ucm -.> view distributed.abra.cadabra -.> names distributed.lib.baz.qux +scratch/main> view distributed.abra.cadabra +scratch/main> names distributed.lib.baz.qux ``` ## Corner cases @@ -86,7 +86,7 @@ bar = 100 ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md index 21aeafa44e..43aa678efd 100644 --- a/unison-src/transcripts/suffixes.output.md +++ b/unison-src/transcripts/suffixes.output.md @@ -2,7 +2,7 @@ Any unique name suffix can be used to refer to a definition. For instance: -```unison +``` unison -- No imports needed even though FQN is `builtin.{Int,Nat}` foo.bar.a : Int foo.bar.a = +99 @@ -15,15 +15,15 @@ optional.isNone = cases This also affects commands like find. Notice lack of qualified names in output: -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: foo.bar.a : Int optional.isNone : Optional a -> Boolean -.> find take +scratch/main> find take 1. builtin.Bytes.take : Nat -> Bytes -> Bytes 2. builtin.List.take : Nat -> [a] -> [a] @@ -35,12 +35,12 @@ This also affects commands like find. Notice lack of qualified names in output: ``` The `view` and `display` commands also benefit from this: -```ucm -.> view List.drop +``` ucm +scratch/main> view List.drop builtin builtin.List.drop : builtin.Nat -> [a] -> [a] -.> display bar.a +scratch/main> display bar.a +99 @@ -49,8 +49,8 @@ In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: -```ucm -.> find : Nat -> [a] -> [a] +``` ucm +scratch/main> find : Nat -> [a] -> [a] 1. builtin.List.drop : Nat -> [a] -> [a] 2. builtin.List.take : Nat -> [a] -> [a] @@ -61,14 +61,14 @@ Type-based search also benefits from this, we can just say `Nat` rather than `.b Suffix-based resolution prefers names that are not in an indirect dependency. -```unison +``` unison cool.abra.cadabra = "my project" lib.distributed.abra.cadabra = "direct dependency 1" lib.distributed.baz.qux = "direct dependency 2" lib.distributed.lib.baz.qux = "indirect dependency" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -84,8 +84,8 @@ lib.distributed.lib.baz.qux = "indirect dependency" lib.distributed.lib.baz.qux : Text ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -95,11 +95,11 @@ lib.distributed.lib.baz.qux = "indirect dependency" lib.distributed.lib.baz.qux : Text ``` -```unison +``` unison > abra.cadabra ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -117,11 +117,11 @@ lib.distributed.lib.baz.qux = "indirect dependency" distributed.abra.cadabra : Text ``` -```unison +``` unison > baz.qux ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -137,8 +137,8 @@ lib.distributed.lib.baz.qux = "indirect dependency" "direct dependency 2" ``` -```ucm -.> view abra.cadabra +``` ucm +scratch/main> view abra.cadabra cool.abra.cadabra : Text cool.abra.cadabra = "my project" @@ -146,7 +146,7 @@ lib.distributed.lib.baz.qux = "indirect dependency" lib.distributed.abra.cadabra : Text lib.distributed.abra.cadabra = "direct dependency 1" -.> view baz.qux +scratch/main> view baz.qux lib.distributed.baz.qux : Text lib.distributed.baz.qux = "direct dependency 2" @@ -154,13 +154,13 @@ lib.distributed.lib.baz.qux = "indirect dependency" ``` Note that we can always still view indirect dependencies by using more name segments: -```ucm -.> view distributed.abra.cadabra +``` ucm +scratch/main> view distributed.abra.cadabra lib.distributed.abra.cadabra : Text lib.distributed.abra.cadabra = "direct dependency 1" -.> names distributed.lib.baz.qux +scratch/main> names distributed.lib.baz.qux Term Hash: #nhup096n2s @@ -173,15 +173,15 @@ Note that we can always still view indirect dependencies by using more name segm If a definition is given in a scratch file, its suffixes shadow existing definitions that exist in the codebase with the same suffixes. For example: -```unison +``` unison unique type A = Thing1 Nat | thing2 Nat foo.a = 23 bar = 100 ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -190,7 +190,7 @@ bar = 100 foo.a : Nat ``` -```unison +``` unison unique type B = Thing1 Text | thing2 Text | Thing3 Text zoink.a = "hi" @@ -207,7 +207,7 @@ fn = cases _ -> todo "hmm" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/sum-type-update-conflicts.md b/unison-src/transcripts/sum-type-update-conflicts.md index ce29931852..1abf98f3ba 100644 --- a/unison-src/transcripts/sum-type-update-conflicts.md +++ b/unison-src/transcripts/sum-type-update-conflicts.md @@ -3,7 +3,7 @@ https://github.com/unisonweb/unison/issues/2786 ```ucm:hide -.ns> builtins.merge +scratch/main> builtins.merge lib.builtins ``` First we add a sum-type to the codebase. @@ -13,7 +13,7 @@ structural type X = x ``` ```ucm -.ns> add +scratch/main> add ``` Now we update the type, changing the name of the constructors, _but_, we simultaneously @@ -32,5 +32,5 @@ This update should succeed since the conflicted constructor is removed in the same update that the new term is being added. ```ucm -.ns> update.old +scratch/main> update.old ``` diff --git a/unison-src/transcripts/sum-type-update-conflicts.output.md b/unison-src/transcripts/sum-type-update-conflicts.output.md index fc45a547bf..ba70632b86 100644 --- a/unison-src/transcripts/sum-type-update-conflicts.output.md +++ b/unison-src/transcripts/sum-type-update-conflicts.output.md @@ -4,11 +4,11 @@ https://github.com/unisonweb/unison/issues/2786 First we add a sum-type to the codebase. -```unison +``` unison structural type X = x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,22 +19,22 @@ structural type X = x ⍟ These new definitions are ok to `add`: structural type X - (also named builtin.Unit) + (also named lib.builtins.Unit) ``` -```ucm -.ns> add +``` ucm +scratch/main> add ⍟ I've added these definitions: structural type X - (also named builtin.Unit) + (also named lib.builtins.Unit) ``` -Now we update the type, changing the name of the constructors, _but_, we simultaneously +Now we update the type, changing the name of the constructors, *but*, we simultaneously add a new top-level term with the same name as the old constructor. -```unison +``` unison structural type X = y | z X.x : Text @@ -43,7 +43,7 @@ X.x = "some text that's not in the codebase" dependsOnX = Text.size X.x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -60,14 +60,14 @@ dependsOnX = Text.size X.x new definition: structural type X - (The old definition is also named builtin.Unit.) + (The old definition is also named lib.builtins.Unit.) ``` This update should succeed since the conflicted constructor is removed in the same update that the new term is being added. -```ucm -.ns> update.old +``` ucm +scratch/main> update.old ⍟ I've added these definitions: @@ -77,6 +77,6 @@ is removed in the same update that the new term is being added. ⍟ I've updated these names to your new definition: structural type X - (The old definition was also named builtin.Unit.) + (The old definition was also named lib.builtins.Unit.) ``` diff --git a/unison-src/transcripts/switch-command.md b/unison-src/transcripts/switch-command.md index c1a2bca962..13e33c8583 100644 --- a/unison-src/transcripts/switch-command.md +++ b/unison-src/transcripts/switch-command.md @@ -22,8 +22,8 @@ the current project can be preceded by a forward slash (which makes it unambiguo forward slash (which makes it unambiguous). ```ucm -.> switch foo -.> switch foo/topic +scratch/main> switch foo +scratch/main> switch foo/topic foo/main> switch topic foo/main> switch /topic foo/main> switch bar/ @@ -38,11 +38,11 @@ foo/main> switch bar It's an error to try to switch to something that doesn't exist, of course. ```ucm:error -.> switch foo/no-such-branch +scratch/main> switch foo/no-such-branch ``` ```ucm:error -.> switch no-such-project +scratch/main> switch no-such-project ``` ```ucm:error diff --git a/unison-src/transcripts/switch-command.output.md b/unison-src/transcripts/switch-command.output.md index 2542da7b32..96778f99d7 100644 --- a/unison-src/transcripts/switch-command.output.md +++ b/unison-src/transcripts/switch-command.output.md @@ -2,11 +2,11 @@ The `switch` command switches to an existing project or branch. Setup stuff. -```unison +``` unison someterm = 18 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ someterm = 18 someterm : Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: @@ -45,10 +45,10 @@ Now, the demo. When unambiguous, `switch` switches to either a project or a bran the current project can be preceded by a forward slash (which makes it unambiguous). A project can be followed by a forward slash (which makes it unambiguous). -```ucm -.> switch foo +``` ucm +scratch/main> switch foo -.> switch foo/topic +scratch/main> switch foo/topic foo/main> switch topic @@ -59,7 +59,7 @@ foo/main> switch bar/ ``` It's an error to try to switch to something ambiguous. -```ucm +``` ucm foo/main> switch bar I'm not sure if you wanted to switch to the branch foo/bar or @@ -73,19 +73,20 @@ foo/main> switch bar ``` It's an error to try to switch to something that doesn't exist, of course. -```ucm -.> switch foo/no-such-branch +``` ucm +scratch/main> switch foo/no-such-branch foo/no-such-branch does not exist. ``` -```ucm -.> switch no-such-project +``` ucm +scratch/main> switch no-such-project - no-such-project does not exist. + Neither project no-such-project nor branch /no-such-project + exists. ``` -```ucm +``` ucm foo/main> switch no-such-project-or-branch Neither project no-such-project-or-branch nor branch diff --git a/unison-src/transcripts/tab-completion.md b/unison-src/transcripts/tab-completion.md index c35c4ba347..e7b7e8b76c 100644 --- a/unison-src/transcripts/tab-completion.md +++ b/unison-src/transcripts/tab-completion.md @@ -5,8 +5,8 @@ Test that tab completion works as expected. ## Tab Complete Command Names ```ucm -.> debug.tab-complete vi -.> debug.tab-complete delete. +scratch/main> debug.tab-complete vi +scratch/main> debug.tab-complete delete. ``` ## Tab complete terms & types @@ -21,35 +21,43 @@ unique type subnamespace.AType = A | B ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -- Should tab complete namespaces since they may contain terms/types -.> debug.tab-complete view sub +scratch/main> debug.tab-complete view sub -- Should not complete things from child namespaces of the current query if there are other completions at this level -.> debug.tab-complete view subnamespace +scratch/main> debug.tab-complete view subnamespace -- Should complete things from child namespaces of the current query if it's dot-suffixed -.> debug.tab-complete view subnamespace. +scratch/main> debug.tab-complete view subnamespace. -- Should complete things from child namespaces of the current query if there are no more completions at this level. -.> debug.tab-complete view subnamespace2 +scratch/main> debug.tab-complete view subnamespace2 -- Should prefix-filter by query suffix -.> debug.tab-complete view subnamespace.some -.> debug.tab-complete view subnamespace.someOther +scratch/main> debug.tab-complete view subnamespace.some +scratch/main> debug.tab-complete view subnamespace.someOther +``` + +```unison:hide +absolute.term = "absolute" +``` + +```ucm +scratch/main> add -- Should tab complete absolute names -.othernamespace> debug.tab-complete view .subnamespace.some +scratch/main> debug.tab-complete view .absolute.te ``` ## Tab complete namespaces ```ucm -- Should tab complete namespaces -.> debug.tab-complete find-in sub -.> debug.tab-complete find-in subnamespace -.> debug.tab-complete find-in subnamespace. -.> debug.tab-complete io.test sub -.> debug.tab-complete io.test subnamespace -.> debug.tab-complete io.test subnamespace. +scratch/main> debug.tab-complete find-in sub +scratch/main> debug.tab-complete find-in subnamespace +scratch/main> debug.tab-complete find-in subnamespace. +scratch/main> debug.tab-complete io.test sub +scratch/main> debug.tab-complete io.test subnamespace +scratch/main> debug.tab-complete io.test subnamespace. ``` Tab Complete Delete Subcommands @@ -61,9 +69,9 @@ add b = b ``` ```ucm -.> update.old -.> debug.tab-complete delete.type Foo -.> debug.tab-complete delete.term add +scratch/main> update.old +scratch/main> debug.tab-complete delete.type Foo +scratch/main> debug.tab-complete delete.term add ``` ## Tab complete projects and branches diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md index 82961cfd5c..2c0103bb95 100644 --- a/unison-src/transcripts/tab-completion.output.md +++ b/unison-src/transcripts/tab-completion.output.md @@ -4,13 +4,13 @@ Test that tab completion works as expected. ## Tab Complete Command Names -```ucm -.> debug.tab-complete vi +``` ucm +scratch/main> debug.tab-complete vi view view.global -.> debug.tab-complete delete. +scratch/main> debug.tab-complete delete. delete.branch delete.namespace @@ -25,7 +25,7 @@ Test that tab completion works as expected. ``` ## Tab complete terms & types -```unison +``` unison subnamespace.someName = 1 subnamespace.someOtherName = 2 subnamespace2.thing = 3 @@ -34,7 +34,7 @@ othernamespace.someName = 4 unique type subnamespace.AType = A | B ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,21 +51,21 @@ unique type subnamespace.AType = A | B subnamespace2.thing : ##Nat ``` -```ucm +``` ucm -- Should tab complete namespaces since they may contain terms/types -.> debug.tab-complete view sub +scratch/main> debug.tab-complete view sub subnamespace. subnamespace2. -- Should not complete things from child namespaces of the current query if there are other completions at this level -.> debug.tab-complete view subnamespace +scratch/main> debug.tab-complete view subnamespace subnamespace. subnamespace2. -- Should complete things from child namespaces of the current query if it's dot-suffixed -.> debug.tab-complete view subnamespace. +scratch/main> debug.tab-complete view subnamespace. * subnamespace.AType subnamespace.AType. @@ -73,57 +73,68 @@ unique type subnamespace.AType = A | B * subnamespace.someOtherName -- Should complete things from child namespaces of the current query if there are no more completions at this level. -.> debug.tab-complete view subnamespace2 +scratch/main> debug.tab-complete view subnamespace2 subnamespace2. * subnamespace2.thing -- Should prefix-filter by query suffix -.> debug.tab-complete view subnamespace.some +scratch/main> debug.tab-complete view subnamespace.some * subnamespace.someName * subnamespace.someOtherName -.> debug.tab-complete view subnamespace.someOther +scratch/main> debug.tab-complete view subnamespace.someOther * subnamespace.someOtherName +``` +``` unison +absolute.term = "absolute" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + absolute.term : ##Text + -- Should tab complete absolute names -.othernamespace> debug.tab-complete view .subnamespace.some +scratch/main> debug.tab-complete view .absolute.te - * .subnamespace.someName - * .subnamespace.someOtherName + * .absolute.term ``` ## Tab complete namespaces -```ucm +``` ucm -- Should tab complete namespaces -.> debug.tab-complete find-in sub +scratch/main> debug.tab-complete find-in sub subnamespace subnamespace2 -.> debug.tab-complete find-in subnamespace +scratch/main> debug.tab-complete find-in subnamespace subnamespace subnamespace2 -.> debug.tab-complete find-in subnamespace. +scratch/main> debug.tab-complete find-in subnamespace. subnamespace.AType -.> debug.tab-complete io.test sub +scratch/main> debug.tab-complete io.test sub subnamespace. subnamespace2. -.> debug.tab-complete io.test subnamespace +scratch/main> debug.tab-complete io.test subnamespace subnamespace. subnamespace2. -.> debug.tab-complete io.test subnamespace. +scratch/main> debug.tab-complete io.test subnamespace. subnamespace.AType. * subnamespace.someName @@ -132,13 +143,13 @@ unique type subnamespace.AType = A | B ``` Tab Complete Delete Subcommands -```unison +``` unison unique type Foo = A | B add : a -> a add b = b ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -152,27 +163,27 @@ add b = b add : a -> a ``` -```ucm -.> update.old +``` ucm +scratch/main> update.old ⍟ I've added these definitions: type Foo add : a -> a -.> debug.tab-complete delete.type Foo +scratch/main> debug.tab-complete delete.type Foo * Foo Foo. -.> debug.tab-complete delete.term add +scratch/main> debug.tab-complete delete.term add * add ``` ## Tab complete projects and branches -```ucm +``` ucm myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. @@ -191,11 +202,11 @@ myproject/main> debug.tab-complete project.rename my ``` Commands which complete namespaces OR branches should list both -```unison +``` unison mybranchsubnamespace.term = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -208,7 +219,7 @@ mybranchsubnamespace.term = 1 mybranchsubnamespace.term : ##Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/test-command.md b/unison-src/transcripts/test-command.md index 2f95c846b7..aedcb1b59d 100644 --- a/unison-src/transcripts/test-command.md +++ b/unison-src/transcripts/test-command.md @@ -1,7 +1,7 @@ Merge builtins so we get enough names for the testing stuff. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` The `test` command should run all of the tests in the current directory. @@ -15,43 +15,43 @@ foo.test2 = [Ok "test2"] ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> test +scratch/main> test ``` Tests should be cached if unchanged. ```ucm -.> test +scratch/main> test ``` `test` won't descend into the `lib` namespace, but `test.all` will. ```unison -testInLib : [Result] -testInLib = [Ok "testInLib"] +lib.dep.testInLib : [Result] +lib.dep.testInLib = [Ok "testInLib"] ``` ```ucm:hide -.lib> add +scratch/main> add ``` ```ucm -.> test -.> test.all +scratch/main> test +scratch/main> test.all ``` -`test` WILL run tests within `lib` if ucm is cd'd inside. +`test` WILL run tests within `lib` if specified explicitly. ```ucm -.lib> test +scratch/main> test lib.dep ``` `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. ```ucm -.> test foo +scratch/main> test foo ``` diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md index a59faee54c..f603bc3f1b 100644 --- a/unison-src/transcripts/test-command.output.md +++ b/unison-src/transcripts/test-command.output.md @@ -2,7 +2,7 @@ Merge builtins so we get enough names for the testing stuff. The `test` command should run all of the tests in the current directory. -```unison +``` unison test1 : [Result] test1 = [Ok "test1"] @@ -10,7 +10,7 @@ foo.test2 : [Result] foo.test2 = [Ok "test2"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,8 +24,8 @@ foo.test2 = [Ok "test2"] test1 : [Result] ``` -```ucm -.> test +``` ucm +scratch/main> test ✅ @@ -39,37 +39,37 @@ foo.test2 = [Ok "test2"] New test results: - ◉ foo.test2 test2 - ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Tests should be cached if unchanged. -```ucm -.> test +``` ucm +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 - ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `test` won't descend into the `lib` namespace, but `test.all` will. -```unison -testInLib : [Result] -testInLib = [Ok "testInLib"] +``` unison +lib.dep.testInLib : [Result] +lib.dep.testInLib = [Ok "testInLib"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -79,28 +79,28 @@ testInLib = [Ok "testInLib"] ⍟ These new definitions are ok to `add`: - testInLib : [Result] + lib.dep.testInLib : [Result] ``` -```ucm -.> test +``` ucm +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 - ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. -.> test.all +scratch/main> test.all Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 - ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing @@ -112,38 +112,38 @@ testInLib = [Ok "testInLib"] New test results: - ◉ lib.testInLib testInLib + 1. lib.dep.testInLib ◉ testInLib ✅ 1 test(s) passing - Tip: Use view lib.testInLib to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` -`test` WILL run tests within `lib` if ucm is cd'd inside. +`test` WILL run tests within `lib` if specified explicitly. -```ucm -.lib> test +``` ucm +scratch/main> test lib.dep Cached test results (`help testcache` to learn more) - ◉ testInLib testInLib + 1. lib.dep.testInLib ◉ testInLib ✅ 1 test(s) passing - Tip: Use view testInLib to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. -```ucm -.> test foo +``` ucm +scratch/main> test foo Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 + 1. foo.test2 ◉ test2 ✅ 1 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/text-literals.md b/unison-src/transcripts/text-literals.md index 06898d1452..3d3b1359aa 100644 --- a/unison-src/transcripts/text-literals.md +++ b/unison-src/transcripts/text-literals.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This transcript shows some syntax for raw text literals. @@ -37,6 +37,6 @@ lit2 = """" ``` ```ucm -.> add -.> view lit1 lit2 +scratch/main> add +scratch/main> view lit1 lit2 ``` \ No newline at end of file diff --git a/unison-src/transcripts/text-literals.output.md b/unison-src/transcripts/text-literals.output.md index efb094d98c..b023a3d062 100644 --- a/unison-src/transcripts/text-literals.output.md +++ b/unison-src/transcripts/text-literals.output.md @@ -1,7 +1,6 @@ - This transcript shows some syntax for raw text literals. -```unison +``` unison lit1 = """ This is a raw text literal. It can start with 3 or more ", @@ -32,7 +31,7 @@ lit2 = """" > Some lit2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -86,15 +85,15 @@ lit2 = """" "This is a raw text literal, indented.\nIt can start with 3 or more \",\nand is terminated by the same number of quotes.\nNothing is escaped. \\n\n\nThis doesn't terminate the literal - \"\"\"" ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: lit1 : Text lit2 : Text -.> view lit1 lit2 +scratch/main> view lit1 lit2 lit1 : Text lit1 = diff --git a/unison-src/transcripts/todo-bug-builtins.md b/unison-src/transcripts/todo-bug-builtins.md index c7d88fb784..e472204d4c 100644 --- a/unison-src/transcripts/todo-bug-builtins.md +++ b/unison-src/transcripts/todo-bug-builtins.md @@ -1,7 +1,7 @@ # The `todo` and `bug` builtin ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` `todo` and `bug` have type `a -> b`. They take a message or a value of type `a` and crash during runtime displaying `a` in ucm. diff --git a/unison-src/transcripts/todo-bug-builtins.output.md b/unison-src/transcripts/todo-bug-builtins.output.md index 0e3bb72ada..932353888f 100644 --- a/unison-src/transcripts/todo-bug-builtins.output.md +++ b/unison-src/transcripts/todo-bug-builtins.output.md @@ -1,11 +1,12 @@ # The `todo` and `bug` builtin `todo` and `bug` have type `a -> b`. They take a message or a value of type `a` and crash during runtime displaying `a` in ucm. -```unison + +``` unison > todo "implement me later" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,11 +29,11 @@ #qe5e1lcfn8 ``` -```unison +``` unison > bug "there's a bug in my code" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,12 +57,14 @@ ``` ## Todo + `todo` is useful if you want to come back to a piece of code later but you want your project to compile. -```unison + +``` unison complicatedMathStuff x = todo "Come back and to something with x here" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -75,14 +78,16 @@ complicatedMathStuff x = todo "Come back and to something with x here" ``` ## Bug + `bug` is used to indicate that a particular branch is not expected to execute. -```unison + +``` unison test = match true with true -> "Yay" false -> bug "Wow, that's unexpected" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index 39fece2f61..46e1eb6165 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -1,139 +1,188 @@ -# Test the `todo` command +# Nothing to do -## Simple type-changing update. +When there's nothing to do, `todo` says this: -```ucm:hide -.simple> builtins.merge +```ucm +scratch/main> todo ``` -```unison:hide -x = 1 -useX = x + 10 +# Dependents of `todo` -type MyType = MyType Nat -useMyType = match MyType 1 with - MyType a -> a + 10 -``` +The `todo` command shows local (outside `lib`) terms that directly call `todo`. ```ucm:hide -.simple> add +scratch/main> builtins.mergeio lib.builtins ``` -Perform a type-changing update so dependents are added to our update frontier. +```unison +foo : Nat +foo = todo "implement foo" -```unison:hide -x = -1 +bar : Nat +bar = foo + foo +``` -type MyType = MyType Text +```ucm +scratch/main> add +scratch/main> todo ``` -```ucm:error -.simple> update.old -.simple> todo +```ucm:hide +scratch/main> delete.project scratch ``` -## A merge with conflicting updates. +# Direct dependencies without names + +The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in +the current namespace. ```ucm:hide -.mergeA> builtins.merge +scratch/main> builtins.mergeio lib.builtins ``` -```unison:hide -x = 1 -type MyType = MyType +```unison +foo.bar = 15 +baz = foo.bar + foo.bar ``` -Set up two branches with the same starting point. +```ucm +scratch/main> add +scratch/main> delete.namespace.force foo +scratch/main> todo +``` ```ucm:hide -.mergeA> add -.> fork .mergeA .mergeB +scratch/main> delete.project scratch ``` -Update `x` to a different term in each branch. +# Conflicted names -```unison:hide -x = 2 -type MyType = MyType Nat -``` +The `todo` command shows conflicted names. ```ucm:hide -.mergeA> update.old +scratch/main> builtins.mergeio lib.builtins ``` -```unison:hide -x = 3 -type MyType = MyType Int +```unison +foo = 16 +bar = 17 ``` -```ucm:hide -.mergeB> update.old +```ucm +scratch/main> add +scratch/main> debug.alias.term.force foo bar +scratch/main> todo ``` -```ucm:error -.mergeA> merge.old .mergeB -.mergeA> todo +```ucm:hide +scratch/main> delete.project scratch ``` -## A named value that appears on the LHS of a patch isn't shown +# Definitions in lib + +The `todo` command complains about terms and types directly in `lib`. ```ucm:hide -.lhs> builtins.merge +scratch/main> builtins.mergeio lib.builtins ``` ```unison -foo = 801 +lib.foo = 16 ``` ```ucm -.lhs> add +scratch/main> add +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` + +# Constructor aliases + +The `todo` command complains about constructor aliases. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins ``` ```unison -foo = 802 +type Foo = One ``` ```ucm -.lhs> update.old +scratch/main> add +scratch/main> alias.term Foo.One Foo.Two +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` + +# Missing constructor names + +The `todo` command complains about missing constructor names. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins ``` ```unison -oldfoo = 801 +type Foo = Bar ``` ```ucm -.lhs> add -.lhs> todo +scratch/main> add +scratch/main> delete.term Foo.Bar +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch ``` -## A type-changing update to one element of a cycle, which doesn't propagate to the other +# Nested decl aliases + +The `todo` command complains about nested decl aliases. ```ucm:hide -.cycle2> builtins.merge +scratch/main> builtins.mergeio lib.builtins ``` ```unison -even = cases - 0 -> true - n -> odd (drop 1 n) - -odd = cases - 0 -> false - n -> even (drop 1 n) +structural type Foo a = One a | Two a a +structural type Foo.inner.Bar a = Uno a | Dos a a ``` ```ucm -.cycle2> add +scratch/main> add +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` + +# Stray constructors + +The `todo` command complains about stray constructors. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins ``` ```unison -even = 17 +type Foo = Bar ``` ```ucm -.cycle2> update.old +scratch/main> add +scratch/main> alias.term Foo.Bar Baz +scratch/main> todo ``` -```ucm:error -.cycle2> todo +```ucm:hide +scratch/main> delete.project scratch ``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index b0a9d69c6d..9b4ba914ba 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -1,140 +1,162 @@ -# Test the `todo` command +# Nothing to do -## Simple type-changing update. +When there's nothing to do, `todo` says this: -```unison -x = 1 -useX = x + 10 +``` ucm +scratch/main> todo + + You have no pending todo items. Good work! ✅ -type MyType = MyType Nat -useMyType = match MyType 1 with - MyType a -> a + 10 ``` +# Dependents of `todo` -Perform a type-changing update so dependents are added to our update frontier. +The `todo` command shows local (outside `lib`) terms that directly call `todo`. -```unison -x = -1 +``` unison +foo : Nat +foo = todo "implement foo" -type MyType = MyType Text +bar : Nat +bar = foo + foo ``` -```ucm -.simple> update.old +``` ucm + + Loading changes detected in scratch.u. - ⍟ I've updated these names to your new definition: + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - type MyType - x : Int + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat -.simple> todo +``` +``` ucm +scratch/main> add - 🚧 - - The namespace has 2 transitive dependent(s) left to upgrade. - Your edit frontier is the dependents of these definitions: - - type #vijug0om28 - #gjmq673r1v : Nat - - I recommend working on them in the following order: - - 1. useMyType : Nat - 2. useX : Nat + ⍟ I've added these definitions: + bar : Nat + foo : Nat + +scratch/main> todo + + These terms call `todo`: + 1. foo ``` -## A merge with conflicting updates. +# Direct dependencies without names -```unison -x = 1 -type MyType = MyType +The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in +the current namespace. + +``` unison +foo.bar = 15 +baz = foo.bar + foo.bar ``` -Set up two branches with the same starting point. +``` ucm -Update `x` to a different term in each branch. + Loading changes detected in scratch.u. -```unison -x = 2 -type MyType = MyType Nat -``` + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + baz : Nat + foo.bar : Nat -```unison -x = 3 -type MyType = MyType Int ``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + baz : Nat + foo.bar : Nat -```ucm -.mergeA> merge.old .mergeB +scratch/main> delete.namespace.force foo - Here's what's changed in the current namespace after the - merge: + Done. + + ⚠️ - New name conflicts: + Of the things I deleted, the following are still used in the + following definitions. They now contain un-named references. - 1. type MyType#ig1g2ka7lv - ↓ - 2. ┌ type MyType#8c6f40i3tj - 3. └ type MyType#ig1g2ka7lv - - 4. MyType.MyType#ig1g2ka7lv#0 : Nat -> MyType#ig1g2ka7lv - ↓ - 5. ┌ MyType.MyType#8c6f40i3tj#0 : Int -> MyType#8c6f40i3tj - 6. └ MyType.MyType#ig1g2ka7lv#0 : Nat -> MyType#ig1g2ka7lv - - 7. x#dcgdua2lj6 : Nat - ↓ - 8. ┌ x#dcgdua2lj6 : Nat - 9. └ x#f3lgjvjqoo : Nat + Dependency Referenced In + bar 1. baz + +scratch/main> todo + + These terms do not have any names in the current namespace: - Updates: + 1. #1jujb8oelv + +``` +# Conflicted names + +The `todo` command shows conflicted names. + +``` unison +foo = 16 +bar = 17 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - 10. patch patch (added 2 updates) + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + bar : Nat + foo : Nat - Applying changes from patch... +scratch/main> debug.alias.term.force foo bar - I tried to auto-apply the patch, but couldn't because it - contained contradictory entries. + Done. -.mergeA> todo +scratch/main> todo ❓ - These definitions were edited differently in namespaces that - have been merged into this one. You'll have to tell me what to - use as the new definition: - - The type 1. #8h7qq3ougl was replaced with - 2. MyType#8c6f40i3tj - 3. MyType#ig1g2ka7lv - The term 4. #gjmq673r1v was replaced with - 5. x#dcgdua2lj6 - 6. x#f3lgjvjqoo - ❓ + The term bar has conflicting definitions: - The term MyType.MyType has conflicting definitions: - 7. MyType.MyType#8c6f40i3tj#0 - 8. MyType.MyType#ig1g2ka7lv#0 + 1. bar#14ibahkll6 + 2. bar#cq22mm4sca - Tip: This occurs when merging branches that both independently - introduce the same name. Use `move.term` or `delete.term` - to resolve the conflicts. + Tip: Use `move.term` or `delete.term` to resolve the + conflicts. ``` -## A named value that appears on the LHS of a patch isn't shown +# Definitions in lib + +The `todo` command complains about terms and types directly in `lib`. -```unison -foo = 801 +``` unison +lib.foo = 16 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -144,22 +166,32 @@ foo = 801 ⍟ These new definitions are ok to `add`: - foo : Nat + lib.foo : Nat ``` -```ucm -.lhs> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - foo : Nat + lib.foo : Nat + +scratch/main> todo + + There's a type or term at the top level of the `lib` + namespace, where I only expect to find subnamespaces + representing library dependencies. Please move or remove it. ``` -```unison -foo = 802 +# Constructor aliases + +The `todo` command complains about constructor aliases. + +``` unison +type Foo = One ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -167,25 +199,41 @@ foo = 802 do an `add` or `update`, here's how your codebase would change: - ⍟ These names already exist. You can `update` them to your - new definition: + ⍟ These new definitions are ok to `add`: - foo : Nat + type Foo ``` -```ucm -.lhs> update.old +``` ucm +scratch/main> add - ⍟ I've updated these names to your new definition: + ⍟ I've added these definitions: - foo : Nat + type Foo + +scratch/main> alias.term Foo.One Foo.Two + + Done. + +scratch/main> todo + + The type Foo has a constructor with multiple names. + + 1. Foo.One + 2. Foo.Two + + Please delete all but one name for each constructor. ``` -```unison -oldfoo = 801 +# Missing constructor names + +The `todo` command complains about missing constructor names. + +``` unison +type Foo = Bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -195,36 +243,41 @@ oldfoo = 801 ⍟ These new definitions are ok to `add`: - oldfoo : Nat + type Foo ``` -```ucm -.lhs> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - oldfoo : Nat + type Foo -.lhs> todo +scratch/main> delete.term Foo.Bar - ✅ + Done. + +scratch/main> todo + + These types have some constructors with missing names. + + 1. Foo - No conflicts or edits in progress. + You can use `view 1` and + `alias.term .` to give names + to each unnamed constructor. ``` -## A type-changing update to one element of a cycle, which doesn't propagate to the other +# Nested decl aliases -```unison -even = cases - 0 -> true - n -> odd (drop 1 n) +The `todo` command complains about nested decl aliases. -odd = cases - 0 -> false - n -> even (drop 1 n) +``` unison +structural type Foo a = One a | Two a a +structural type Foo.inner.Bar a = Uno a | Dos a a ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -234,24 +287,36 @@ odd = cases ⍟ These new definitions are ok to `add`: - even : Nat -> Boolean - odd : Nat -> Boolean + structural type Foo a + structural type Foo.inner.Bar a ``` -```ucm -.cycle2> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - even : Nat -> Boolean - odd : Nat -> Boolean + structural type Foo a + structural type Foo.inner.Bar a + +scratch/main> todo + + These types are aliases, but one is nested under the other. + Please separate them or delete one copy. + + 1. Foo + 2. Foo.inner.Bar ``` -```unison -even = 17 +# Stray constructors + +The `todo` command complains about stray constructors. + +``` unison +type Foo = Bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -259,34 +324,30 @@ even = 17 do an `add` or `update`, here's how your codebase would change: - ⍟ These names already exist. You can `update` them to your - new definition: + ⍟ These new definitions are ok to `add`: - even : Nat + type Foo ``` -```ucm -.cycle2> update.old +``` ucm +scratch/main> add - ⍟ I've updated these names to your new definition: + ⍟ I've added these definitions: - even : Nat + type Foo -``` -```ucm -.cycle2> todo +scratch/main> alias.term Foo.Bar Baz - 🚧 - - The namespace has 1 transitive dependent(s) left to upgrade. - Your edit frontier is the dependents of these definitions: - - #kkohl7ba1e : Nat -> Boolean - - I recommend working on them in the following order: - - 1. odd : Nat -> Boolean + Done. + +scratch/main> todo + + These constructors are not nested beneath their corresponding + type names: + 1. Baz + For each one, please either use `move` to move if, or if it's + an extra copy, you can simply `delete` it. ``` diff --git a/unison-src/transcripts/top-level-exceptions.md b/unison-src/transcripts/top-level-exceptions.md index 8749984744..4caf9d717c 100644 --- a/unison-src/transcripts/top-level-exceptions.md +++ b/unison-src/transcripts/top-level-exceptions.md @@ -2,13 +2,13 @@ A simple transcript to test the use of exceptions that bubble to the top level. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` FYI, here are the `Exception` and `Failure` types: ```ucm -.> view Exception Failure +scratch/main> view Exception Failure ``` Here's a sample program just to verify that the typechecker allows `run` to throw exceptions: @@ -24,9 +24,9 @@ mytest _ = [Ok "Great"] ``` ```ucm -.> run main -.> add -.> io.test mytest +scratch/main> run main +scratch/main> add +scratch/main> io.test mytest ``` Now a test to show the handling of uncaught exceptions: @@ -42,5 +42,5 @@ unique type RuntimeError = ``` ```ucm:error -.> run main2 +scratch/main> run main2 ``` diff --git a/unison-src/transcripts/top-level-exceptions.output.md b/unison-src/transcripts/top-level-exceptions.output.md index 745e94c657..ded6bdda0e 100644 --- a/unison-src/transcripts/top-level-exceptions.output.md +++ b/unison-src/transcripts/top-level-exceptions.output.md @@ -1,10 +1,9 @@ - A simple transcript to test the use of exceptions that bubble to the top level. FYI, here are the `Exception` and `Failure` types: -```ucm -.> view Exception Failure +``` ucm +scratch/main> view Exception Failure structural ability builtin.Exception where raise : Failure ->{builtin.Exception} x @@ -15,7 +14,7 @@ FYI, here are the `Exception` and `Failure` types: ``` Here's a sample program just to verify that the typechecker allows `run` to throw exceptions: -```unison +``` unison use builtin IO Exception Test.Result main : '{IO, Exception} () @@ -25,7 +24,7 @@ mytest : '{IO, Exception} [Test.Result] mytest _ = [Ok "Great"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -39,32 +38,32 @@ mytest _ = [Ok "Great"] mytest : '{IO, Exception} [Result] ``` -```ucm -.> run main +``` ucm +scratch/main> run main () -.> add +scratch/main> add ⍟ I've added these definitions: main : '{IO, Exception} () mytest : '{IO, Exception} [Result] -.> io.test mytest +scratch/main> io.test mytest New test results: - ◉ mytest Great + 1. mytest ◉ Great ✅ 1 test(s) passing - Tip: Use view mytest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Now a test to show the handling of uncaught exceptions: -```unison +``` unison main2 = '(error "oh noes!" ()) error : Text -> a ->{Exception} x @@ -74,7 +73,7 @@ error msg a = unique type RuntimeError = ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -89,8 +88,8 @@ unique type RuntimeError = main2 : '{Exception} r ``` -```ucm -.> run main2 +``` ucm +scratch/main> run main2 💔💥 diff --git a/unison-src/transcripts/transcript-parser-commands.md b/unison-src/transcripts/transcript-parser-commands.md index e39fd10885..afd90011ea 100644 --- a/unison-src/transcripts/transcript-parser-commands.md +++ b/unison-src/transcripts/transcript-parser-commands.md @@ -1,7 +1,7 @@ ### Transcript parser operations ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` The transcript parser is meant to parse `ucm` and `unison` blocks. @@ -11,7 +11,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ``` ```unison:hide:error:scratch.u @@ -19,11 +19,11 @@ z ``` ```ucm:error -.> delete foo +scratch/main> delete foo ``` ```ucm :error -.> delete lineToken.call +scratch/main> delete lineToken.call ``` However handling of blocks of other languages should be supported. diff --git a/unison-src/transcripts/transcript-parser-commands.output.md b/unison-src/transcripts/transcript-parser-commands.output.md index 15b72bc3b1..af7d730d15 100644 --- a/unison-src/transcripts/transcript-parser-commands.output.md +++ b/unison-src/transcripts/transcript-parser-commands.output.md @@ -2,11 +2,11 @@ The transcript parser is meant to parse `ucm` and `unison` blocks. -```unison +``` unison x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,15 +19,15 @@ x = 1 x : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: x : Nat ``` -```unison +``` unison --- title: :scratch.u --- @@ -35,9 +35,8 @@ z ``` - -```ucm -.> delete foo +``` ucm +scratch/main> delete foo ⚠️ @@ -45,8 +44,8 @@ z foo ``` -```ucm -.> delete lineToken.call +``` ucm +scratch/main> delete lineToken.call ⚠️ @@ -56,21 +55,15 @@ z ``` However handling of blocks of other languages should be supported. -```python - +``` python some python code - ``` -```c_cpp - +``` c_cpp some C++ code - ``` -```c9search - +``` c9search some cloud9 code - ``` diff --git a/unison-src/transcripts/type-deps.md b/unison-src/transcripts/type-deps.md index 142265c786..e63b539d50 100644 --- a/unison-src/transcripts/type-deps.md +++ b/unison-src/transcripts/type-deps.md @@ -3,7 +3,7 @@ https://github.com/unisonweb/unison/pull/2821 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` @@ -14,7 +14,7 @@ structural type Y = Y ``` ```ucm:hide -.> add +scratch/main> add ``` Now, we update `Y`, and add a new type `Z` which depends on it. @@ -26,7 +26,7 @@ structural type Y = Y Nat Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. ```ucm:error -.> add +scratch/main> add -- This shouldn't exist, because it should've been blocked. -.> view Z +scratch/main> view Z ``` diff --git a/unison-src/transcripts/type-deps.output.md b/unison-src/transcripts/type-deps.output.md index b3a18e310d..fb04cc34c4 100644 --- a/unison-src/transcripts/type-deps.output.md +++ b/unison-src/transcripts/type-deps.output.md @@ -4,18 +4,18 @@ https://github.com/unisonweb/unison/pull/2821 Define a type. -```unison +``` unison structural type Y = Y ``` Now, we update `Y`, and add a new type `Z` which depends on it. -```unison +``` unison structural type Z = Z Y structural type Y = Y Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -35,8 +35,9 @@ structural type Y = Y Nat ``` Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. -```ucm -.> add + +``` ucm +scratch/main> add x These definitions failed: @@ -47,7 +48,7 @@ Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked Tip: Use `help filestatus` to learn more. -- This shouldn't exist, because it should've been blocked. -.> view Z +scratch/main> view Z ⚠️ diff --git a/unison-src/transcripts/type-modifier-are-optional.md b/unison-src/transcripts/type-modifier-are-optional.md index abce0ad0b8..f0a13f59ea 100644 --- a/unison-src/transcripts/type-modifier-are-optional.md +++ b/unison-src/transcripts/type-modifier-are-optional.md @@ -1,7 +1,7 @@ # Type modifiers are optional, `unique` is the default. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Types and abilities may be prefixed with either `unique` or `structural`. When left unspecified, `unique` is assumed. diff --git a/unison-src/transcripts/type-modifier-are-optional.output.md b/unison-src/transcripts/type-modifier-are-optional.output.md index 88b7844127..6cd6812daa 100644 --- a/unison-src/transcripts/type-modifier-are-optional.output.md +++ b/unison-src/transcripts/type-modifier-are-optional.output.md @@ -2,7 +2,7 @@ Types and abilities may be prefixed with either `unique` or `structural`. When left unspecified, `unique` is assumed. -```unison +``` unison type Abc = Abc unique type Def = Def structural type Ghi = Ghi @@ -12,7 +12,7 @@ unique ability MyAbilityU where const : a structural ability MyAbilityS where const : a ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/undo.md b/unison-src/transcripts/undo.md new file mode 100644 index 0000000000..112fc30eb3 --- /dev/null +++ b/unison-src/transcripts/undo.md @@ -0,0 +1,51 @@ +# Undo + +Undo should pop a node off of the history of the current branch. + +```unison:hide +x = 1 +``` + +```ucm +scratch/main> builtins.merge lib.builtins +scratch/main> add +scratch/main> ls +scratch/main> alias.term x y +scratch/main> ls +scratch/main> history +scratch/main> undo +scratch/main> ls +scratch/main> history +``` + +--- + +It should not be affected by changes on other branches. + +```unison:hide +x = 1 +``` + +```ucm +scratch/branch1> builtins.merge lib.builtins +scratch/branch1> add +scratch/branch1> ls +scratch/branch1> alias.term x y +scratch/branch1> ls +scratch/branch1> history +-- Make some changes on an unrelated branch +scratch/branch2> builtins.merge lib.builtins +scratch/branch2> delete.namespace lib +scratch/branch1> undo +scratch/branch1> ls +scratch/branch1> history +``` + +--- + +Undo should be a no-op on a newly created branch + +```ucm:error +scratch/main> branch.create-empty new +scratch/new> undo +``` diff --git a/unison-src/transcripts/undo.output.md b/unison-src/transcripts/undo.output.md new file mode 100644 index 0000000000..32933a2fb9 --- /dev/null +++ b/unison-src/transcripts/undo.output.md @@ -0,0 +1,199 @@ +# Undo + +Undo should pop a node off of the history of the current branch. + +``` unison +x = 1 +``` + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +scratch/main> add + + ⍟ I've added these definitions: + + x : Nat + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> alias.term x y + + Done. + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + 3. y (Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #nmem6r6no1 + + + Adds / updates: + + y + + = Copies: + + Original name New name(s) + x y + + ⊙ 2. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 3. #ms9lggs2rg (start of history) + +scratch/main> undo + + Here are the changes I undid + + Name changes: + + Original Changes + 1. x 2. y (added) + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 2. #ms9lggs2rg (start of history) + +``` +----- + +It should not be affected by changes on other branches. + +``` unison +x = 1 +``` + +``` ucm +scratch/branch1> builtins.merge lib.builtins + + Done. + +scratch/branch1> add + + ⍟ I've added these definitions: + + x : Nat + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/branch1> alias.term x y + + Done. + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + 3. y (Nat) + +scratch/branch1> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #nmem6r6no1 + + + Adds / updates: + + y + + = Copies: + + Original name New name(s) + x y + + ⊙ 2. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 3. #ms9lggs2rg (start of history) + +-- Make some changes on an unrelated branch +scratch/branch2> builtins.merge lib.builtins + + Done. + +scratch/branch2> delete.namespace lib + + Done. + +scratch/branch1> undo + + Here are the changes I undid + + Name changes: + + Original Changes + 1. x 2. y (added) + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/branch1> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 2. #ms9lggs2rg (start of history) + +``` +----- + +Undo should be a no-op on a newly created branch + +``` ucm +scratch/main> branch.create-empty new + + Done. I've created an empty branch scratch/new. + + Tip: Use `merge /somebranch` to initialize this branch. + +scratch/new> undo + + ⚠️ + + Nothing more to undo. + +``` diff --git a/unison-src/transcripts/unique-type-churn.md b/unison-src/transcripts/unique-type-churn.md index 904e1c480c..d35b2fa09a 100644 --- a/unison-src/transcripts/unique-type-churn.md +++ b/unison-src/transcripts/unique-type-churn.md @@ -9,7 +9,7 @@ unique type C = C B ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,7 +22,7 @@ unique type C = C B If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. ```ucm -.> names A +scratch/main> names A ``` ```unison @@ -30,8 +30,8 @@ unique type A = A () ``` ```ucm -.> update -.> names A +scratch/main> update +scratch/main> names A ``` ```unison @@ -41,6 +41,6 @@ unique type A = A Note that `A` is back to its original hash. ```ucm -.> update -.> names A +scratch/main> update +scratch/main> names A ``` diff --git a/unison-src/transcripts/unique-type-churn.output.md b/unison-src/transcripts/unique-type-churn.output.md index bcee03f59e..ea00586436 100644 --- a/unison-src/transcripts/unique-type-churn.output.md +++ b/unison-src/transcripts/unique-type-churn.output.md @@ -1,14 +1,14 @@ This transcript demonstrates that unique types no longer always get a fresh GUID: they share GUIDs with already-saved unique types of the same name. -```unison +``` unison unique type A = A unique type B = B C unique type C = C B ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,8 +23,8 @@ unique type C = C B type C ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -33,14 +33,14 @@ unique type C = C B type C ``` -```unison +``` unison unique type A = A unique type B = B C unique type C = C B ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,8 +50,8 @@ unique type C = C B ``` If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. -```ucm -.> names A +``` ucm +scratch/main> names A Type Hash: #uj8oalgadr @@ -64,11 +64,11 @@ If the name stays the same, the churn is even prevented if the type is updated a Tip: Use `names.global` to see more results. ``` -```unison +``` unison unique type A = A () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -82,15 +82,15 @@ unique type A = A () type A ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> names A +scratch/main> names A Type Hash: #ufo5tuc7ho @@ -103,11 +103,11 @@ unique type A = A () Tip: Use `names.global` to see more results. ``` -```unison +``` unison unique type A = A ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -123,15 +123,15 @@ unique type A = A ``` Note that `A` is back to its original hash. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> names A +scratch/main> names A Type Hash: #uj8oalgadr diff --git a/unison-src/transcripts/unitnamespace.md b/unison-src/transcripts/unitnamespace.md index 0f6838dae5..c1f9f5fc5b 100644 --- a/unison-src/transcripts/unitnamespace.md +++ b/unison-src/transcripts/unitnamespace.md @@ -1,10 +1,10 @@ ```unison -foo = "bar" +`()`.foo = "bar" ``` ```ucm -.`()`> add -.> find -.> find-in `()` -.> delete.namespace `()` +scratch/main> add +scratch/main> find +scratch/main> find-in `()` +scratch/main> delete.namespace `()` ``` diff --git a/unison-src/transcripts/unitnamespace.output.md b/unison-src/transcripts/unitnamespace.output.md index 9e18ea08ef..0a4833afee 100644 --- a/unison-src/transcripts/unitnamespace.output.md +++ b/unison-src/transcripts/unitnamespace.output.md @@ -1,8 +1,8 @@ -```unison -foo = "bar" +``` unison +`()`.foo = "bar" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -12,29 +12,27 @@ foo = "bar" ⍟ These new definitions are ok to `add`: - foo : ##Text + `()`.foo : ##Text ``` -```ucm - ☝️ The namespace .`()` is empty. - -.`()`> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - foo : ##Text + `()`.foo : ##Text -.> find +scratch/main> find 1. `()`.foo : ##Text -.> find-in `()` +scratch/main> find-in `()` 1. foo : ##Text -.> delete.namespace `()` +scratch/main> delete.namespace `()` Done. diff --git a/unison-src/transcripts/universal-cmp.md b/unison-src/transcripts/universal-cmp.md index 2364cb39c2..7e41982e99 100644 --- a/unison-src/transcripts/universal-cmp.md +++ b/unison-src/transcripts/universal-cmp.md @@ -3,7 +3,7 @@ File for test cases making sure that universal equality/comparison cases exist for built-in types. Just making sure they don't crash. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -16,8 +16,8 @@ threadEyeDeez _ = ``` ```ucm -.> add -.> run threadEyeDeez +scratch/main> add +scratch/main> run threadEyeDeez ``` ```unison diff --git a/unison-src/transcripts/universal-cmp.output.md b/unison-src/transcripts/universal-cmp.output.md index ec03128e87..5b8913fffa 100644 --- a/unison-src/transcripts/universal-cmp.output.md +++ b/unison-src/transcripts/universal-cmp.output.md @@ -1,8 +1,7 @@ - File for test cases making sure that universal equality/comparison cases exist for built-in types. Just making sure they don't crash. -```unison +``` unison unique type A = A threadEyeDeez _ = @@ -11,7 +10,7 @@ threadEyeDeez _ = (t1 == t2, t1 < t2) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,27 +24,27 @@ threadEyeDeez _ = threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type A threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) -.> run threadEyeDeez +scratch/main> run threadEyeDeez (false, true) ``` -```unison +``` unison > typeLink A == typeLink A > typeLink Text == typeLink Text > typeLink Text == typeLink A > termLink threadEyeDeez == termLink threadEyeDeez ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/unsafe-coerce.md b/unison-src/transcripts/unsafe-coerce.md index ab3c38481e..9b483f9bbf 100644 --- a/unison-src/transcripts/unsafe-coerce.md +++ b/unison-src/transcripts/unsafe-coerce.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -17,7 +17,7 @@ main _ = ``` ```ucm -.> find unsafe.coerceAbilities -.> add -.> io.test main +scratch/main> find unsafe.coerceAbilities +scratch/main> add +scratch/main> io.test main ``` diff --git a/unison-src/transcripts/unsafe-coerce.output.md b/unison-src/transcripts/unsafe-coerce.output.md index 8736e6e9cd..20380cb69f 100644 --- a/unison-src/transcripts/unsafe-coerce.output.md +++ b/unison-src/transcripts/unsafe-coerce.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison f : '{} Nat f _ = 5 @@ -12,7 +11,7 @@ main _ = if n == 5 then [Ok ""] else [Fail ""] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,13 +26,13 @@ main _ = main : '{IO, Exception} [Result] ``` -```ucm -.> find unsafe.coerceAbilities +``` ucm +scratch/main> find unsafe.coerceAbilities 1. builtin.unsafe.coerceAbilities : (a ->{e1} b) -> a -> b -.> add +scratch/main> add ⍟ I've added these definitions: @@ -41,14 +40,14 @@ main _ = fc : '{IO, Exception} Nat main : '{IO, Exception} [Result] -.> io.test main +scratch/main> io.test main New test results: - ◉ main + 1. main ◉ ✅ 1 test(s) passing - Tip: Use view main to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/update-ignores-lib-namespace.md b/unison-src/transcripts/update-ignores-lib-namespace.md index 04498e48ab..2db633f143 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.md @@ -3,7 +3,7 @@ the project organization convention that dependencies are put in "lib"; it's muc one's own code if the "lib" namespace is simply ignored. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -12,7 +12,7 @@ lib.foo = 100 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,6 +20,6 @@ foo = 200 ``` ```ucm -.> update -.> names foo +scratch/main> update +scratch/main> names foo ``` diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md index 5711f81a81..dc03596d08 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.output.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.output.md @@ -2,12 +2,12 @@ the project organization convention that dependencies are put in "lib"; it's much easier to apply a patch to all of one's own code if the "lib" namespace is simply ignored. -```unison +``` unison foo = 100 lib.foo = 100 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,8 +21,8 @@ lib.foo = 100 lib.foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -30,11 +30,11 @@ lib.foo = 100 lib.foo : Nat ``` -```unison +``` unison foo = 200 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,15 +49,15 @@ foo = 200 (The old definition is also named lib.foo.) ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> names foo +scratch/main> names foo Term Hash: #9ntnotdp87 diff --git a/unison-src/transcripts/update-on-conflict.md b/unison-src/transcripts/update-on-conflict.md index 21b9a656cb..e36c20fdff 100644 --- a/unison-src/transcripts/update-on-conflict.md +++ b/unison-src/transcripts/update-on-conflict.md @@ -1,28 +1,27 @@ # Update on conflict +Updating conflicted definitions works fine. + ```ucm:hide -.> builtins.merge -.merged> builtins.merge +scratch/main> builtins.merge lib.builtins ``` ```unison -a.x = 1 -b.x = 2 +x = 1 +temp = 2 ``` -Cause a conflict: ```ucm -.> add -.merged> merge.old .a -.merged> merge.old .b +scratch/main> add +scratch/main> debug.alias.term.force temp x +scratch/main> delete.term temp ``` -Updating conflicted definitions works fine. - ```unison x = 3 ``` ```ucm -.merged> update +scratch/main> update +scratch/main> view x ``` diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index 6a9afd2e93..373d3ac22d 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -1,11 +1,13 @@ # Update on conflict -```unison -a.x = 1 -b.x = 2 +Updating conflicted definitions works fine. + +``` unison +x = 1 +temp = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,62 +17,32 @@ b.x = 2 ⍟ These new definitions are ok to `add`: - a.x : Nat - b.x : Nat + temp : Nat + x : Nat ``` -Cause a conflict: -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: - a.x : Nat - b.x : Nat - -.merged> merge.old .a - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + temp : Nat + x : Nat - Applying changes from patch... +scratch/main> debug.alias.term.force temp x -.merged> merge.old .b + Done. - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. x#gjmq673r1v : Nat - ↓ - 2. ┌ x#dcgdua2lj6 : Nat - 3. └ x#gjmq673r1v : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. +scratch/main> delete.term temp - Applying changes from patch... + Done. ``` -Updating conflicted definitions works fine. - -```unison +``` unison x = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -84,12 +56,17 @@ x = 3 x : Nat ``` -```ucm -.merged> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. +scratch/main> view x + + x : Nat + x = 3 + ``` diff --git a/unison-src/transcripts/update-suffixifies-properly.output.md b/unison-src/transcripts/update-suffixifies-properly.output.md index 812eac20e2..b76176388b 100644 --- a/unison-src/transcripts/update-suffixifies-properly.output.md +++ b/unison-src/transcripts/update-suffixifies-properly.output.md @@ -1,4 +1,4 @@ -```unison +``` unison a.x.x.x.x = 100 b.x.x.x.x = 100 foo = 25 @@ -7,7 +7,7 @@ d.y.y.y.y = foo + 10 bar = a.x.x.x.x + c.y.y.y.y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,7 +25,7 @@ bar = a.x.x.x.x + c.y.y.y.y foo : Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: @@ -38,11 +38,11 @@ myproject/main> add foo : Nat ``` -```unison +``` unison foo = +30 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +56,7 @@ foo = +30 foo : Int ``` -```ucm +``` ucm myproject/main> update Okay, I'm searching the branch for code that needs to be @@ -69,7 +69,7 @@ myproject/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Nat bar = use Nat + diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.md b/unison-src/transcripts/update-term-aliases-in-different-ways.md index fd8a8816c0..e99deb63be 100644 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.md +++ b/unison-src/transcripts/update-term-aliases-in-different-ways.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -23,6 +23,6 @@ bar = 7 ``` ```ucm -.> update -.> view foo bar +scratch/main> update +scratch/main> view foo bar ``` diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md index 2d7960976a..5b0e7bf65d 100644 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md +++ b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md @@ -1,10 +1,10 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -12,7 +12,7 @@ bar : Nat bar = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,8 +26,8 @@ bar = 5 foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -35,7 +35,7 @@ bar = 5 foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 @@ -43,7 +43,7 @@ bar : Nat bar = 7 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -60,15 +60,15 @@ bar = 7 (The old definition is also named bar.) ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo bar +scratch/main> view foo bar bar : Nat bar = 7 diff --git a/unison-src/transcripts/update-term-to-different-type.md b/unison-src/transcripts/update-term-to-different-type.md index 3fa5a735f9..31859e3a13 100644 --- a/unison-src/transcripts/update-term-to-different-type.md +++ b/unison-src/transcripts/update-term-to-different-type.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -8,7 +8,7 @@ foo = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,6 +17,6 @@ foo = +5 ``` ```ucm -.> update -.> view foo +scratch/main> update +scratch/main> view foo ``` diff --git a/unison-src/transcripts/update-term-to-different-type.output.md b/unison-src/transcripts/update-term-to-different-type.output.md index 7f6bf57ccf..c1f65aacac 100644 --- a/unison-src/transcripts/update-term-to-different-type.output.md +++ b/unison-src/transcripts/update-term-to-different-type.output.md @@ -1,15 +1,15 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,20 +22,20 @@ foo = 5 foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: foo : Nat ``` -```unison +``` unison foo : Int foo = +5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,15 +49,15 @@ foo = +5 foo : Int ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo +scratch/main> view foo foo : Int foo = +5 diff --git a/unison-src/transcripts/update-term-with-alias.md b/unison-src/transcripts/update-term-with-alias.md index b3c5e9e791..e45eb8b768 100644 --- a/unison-src/transcripts/update-term-with-alias.md +++ b/unison-src/transcripts/update-term-with-alias.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,6 +20,6 @@ foo = 6 ``` ```ucm -.> update -.> view foo bar +scratch/main> update +scratch/main> view foo bar ``` diff --git a/unison-src/transcripts/update-term-with-alias.output.md b/unison-src/transcripts/update-term-with-alias.output.md index abf21943aa..b0fbeab2ae 100644 --- a/unison-src/transcripts/update-term-with-alias.output.md +++ b/unison-src/transcripts/update-term-with-alias.output.md @@ -1,10 +1,10 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -12,7 +12,7 @@ bar : Nat bar = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,8 +26,8 @@ bar = 5 foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -35,12 +35,12 @@ bar = 5 foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -55,15 +55,15 @@ foo = 6 (The old definition is also named bar.) ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo bar +scratch/main> view foo bar bar : Nat bar = 5 diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.md index c9d6388dc3..b7bd1196ae 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = foo + 10 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,5 +20,5 @@ foo = +5 ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md index 1a62cebf4a..02eeabcfc2 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md @@ -1,10 +1,10 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -12,7 +12,7 @@ bar : Nat bar = foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,8 +26,8 @@ bar = foo + 10 foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -35,12 +35,12 @@ bar = foo + 10 foo : Nat ``` -```unison +``` unison foo : Int foo = +5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -54,8 +54,8 @@ foo = +5 foo : Int ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -67,7 +67,7 @@ foo = +5 `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Nat bar = use Nat + diff --git a/unison-src/transcripts/update-term-with-dependent.md b/unison-src/transcripts/update-term-with-dependent.md index d7aa6b3db6..402138857b 100644 --- a/unison-src/transcripts/update-term-with-dependent.md +++ b/unison-src/transcripts/update-term-with-dependent.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = foo + 10 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,6 +20,6 @@ foo = 6 ``` ```ucm -.> update -.> view bar +scratch/main> update +scratch/main> view bar ``` diff --git a/unison-src/transcripts/update-term-with-dependent.output.md b/unison-src/transcripts/update-term-with-dependent.output.md index dc2d66f72a..42ae8158f5 100644 --- a/unison-src/transcripts/update-term-with-dependent.output.md +++ b/unison-src/transcripts/update-term-with-dependent.output.md @@ -1,10 +1,10 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -12,7 +12,7 @@ bar : Nat bar = foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,8 +26,8 @@ bar = foo + 10 foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -35,12 +35,12 @@ bar = foo + 10 foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -54,8 +54,8 @@ foo = 6 foo : Nat ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -66,7 +66,7 @@ foo = 6 Done. -.> view bar +scratch/main> view bar bar : Nat bar = diff --git a/unison-src/transcripts/update-term.md b/unison-src/transcripts/update-term.md index 0fbb55357b..0cdc0e86f9 100644 --- a/unison-src/transcripts/update-term.md +++ b/unison-src/transcripts/update-term.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -8,7 +8,7 @@ foo = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,6 +17,6 @@ foo = 6 ``` ```ucm -.> update -.> view foo +scratch/main> update +scratch/main> view foo ``` diff --git a/unison-src/transcripts/update-term.output.md b/unison-src/transcripts/update-term.output.md index 1a641671e5..54abb8e06a 100644 --- a/unison-src/transcripts/update-term.output.md +++ b/unison-src/transcripts/update-term.output.md @@ -1,15 +1,15 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,20 +22,20 @@ foo = 5 foo : Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,15 +49,15 @@ foo = 6 foo : Nat ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo +scratch/main> view foo foo : Nat foo = 6 diff --git a/unison-src/transcripts/update-test-to-non-test.md b/unison-src/transcripts/update-test-to-non-test.md index a25ad0d3e2..0c2ba33f80 100644 --- a/unison-src/transcripts/update-test-to-non-test.md +++ b/unison-src/transcripts/update-test-to-non-test.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -9,8 +9,8 @@ test> foo = [] After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) ```ucm -.> add -.> view foo +scratch/main> add +scratch/main> view foo ``` ```unison @@ -20,6 +20,6 @@ foo = 1 After updating `foo` to not be a test, we expect `view` to not render it like a test. ```ucm -.> update -.> view foo +scratch/main> update +scratch/main> view foo ``` diff --git a/unison-src/transcripts/update-test-to-non-test.output.md b/unison-src/transcripts/update-test-to-non-test.output.md index a3a016e736..5275b97eb3 100644 --- a/unison-src/transcripts/update-test-to-non-test.output.md +++ b/unison-src/transcripts/update-test-to-non-test.output.md @@ -1,14 +1,14 @@ -```ucm -.> builtins.merge +``` ucm +scratch/main> builtins.merge Done. ``` -```unison +``` unison test> foo = [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,24 +29,24 @@ test> foo = [] ``` After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: foo : [Result] -.> view foo +scratch/main> view foo foo : [Result] foo = [] ``` -```unison +``` unison foo = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -62,15 +62,15 @@ foo = 1 ``` After updating `foo` to not be a test, we expect `view` to not render it like a test. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo +scratch/main> view foo foo : Nat foo = 1 diff --git a/unison-src/transcripts/update-test-watch-roundtrip.md b/unison-src/transcripts/update-test-watch-roundtrip.md index a3ea386efe..135412df66 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Given a test that depends on another definition, @@ -14,7 +14,7 @@ test> mynamespace.foo.test = ``` ```ucm -.> add +scratch/main> add ``` if we change the type of the dependency, the test should show in the scratch file as a test watch. @@ -24,5 +24,5 @@ foo n = "hello, world!" ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-test-watch-roundtrip.output.md b/unison-src/transcripts/update-test-watch-roundtrip.output.md index b3db6133dd..31aa18ea23 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.output.md @@ -1,7 +1,6 @@ - Given a test that depends on another definition, -```unison +``` unison foo n = n + 1 test> mynamespace.foo.test = @@ -9,8 +8,8 @@ test> mynamespace.foo.test = if (foo n) == 2 then [ Ok "passed" ] else [ Fail "wat" ] ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -20,11 +19,11 @@ test> mynamespace.foo.test = ``` if we change the type of the dependency, the test should show in the scratch file as a test watch. -```unison +``` unison foo n = "hello, world!" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -38,8 +37,8 @@ foo n = "hello, world!" foo : n -> Text ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -51,7 +50,7 @@ foo n = "hello, world!" `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u test> mynamespace.foo.test = n = 2 if foo n == 2 then [Ok "passed"] else [Fail "wat"] diff --git a/unison-src/transcripts/update-type-add-constructor.md b/unison-src/transcripts/update-type-add-constructor.md index b801106c24..1decf30154 100644 --- a/unison-src/transcripts/update-type-add-constructor.md +++ b/unison-src/transcripts/update-type-add-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -8,7 +8,7 @@ unique type Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,7 +18,7 @@ unique type Foo ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-add-constructor.output.md b/unison-src/transcripts/update-type-add-constructor.output.md index d0fb21a382..c87b1b7cd8 100644 --- a/unison-src/transcripts/update-type-add-constructor.output.md +++ b/unison-src/transcripts/update-type-add-constructor.output.md @@ -1,9 +1,9 @@ -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -16,21 +16,21 @@ unique type Foo type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo ``` -```unison +``` unison unique type Foo = Bar Nat | Baz Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,19 +44,19 @@ unique type Foo type Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat | Baz Nat Nat -.> find.verbose +scratch/main> find.verbose 1. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog type Foo diff --git a/unison-src/transcripts/update-type-add-field.md b/unison-src/transcripts/update-type-add-field.md index 13a388e1bd..cdd41c3388 100644 --- a/unison-src/transcripts/update-type-add-field.md +++ b/unison-src/transcripts/update-type-add-field.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = Bar Nat ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,7 +15,7 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-add-field.output.md b/unison-src/transcripts/update-type-add-field.output.md index 7ee979d64e..6741c27a09 100644 --- a/unison-src/transcripts/update-type-add-field.output.md +++ b/unison-src/transcripts/update-type-add-field.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,19 +15,19 @@ unique type Foo = Bar Nat type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -41,19 +41,19 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat Nat -.> find.verbose +scratch/main> find.verbose 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g type Foo diff --git a/unison-src/transcripts/update-type-add-new-record.md b/unison-src/transcripts/update-type-add-new-record.md index 0d311ec1e2..a7f82df0c8 100644 --- a/unison-src/transcripts/update-type-add-new-record.md +++ b/unison-src/transcripts/update-type-add-new-record.md @@ -1,5 +1,5 @@ ```ucm:hide -.lib> builtins.merge +scratch/main> builtins.merge lib.builtins ``` ```unison @@ -7,6 +7,6 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> update -.> view Foo +scratch/main> update +scratch/main> view Foo ``` diff --git a/unison-src/transcripts/update-type-add-new-record.output.md b/unison-src/transcripts/update-type-add-new-record.output.md index 8c00d6c1de..a96ce90c24 100644 --- a/unison-src/transcripts/update-type-add-new-record.output.md +++ b/unison-src/transcripts/update-type-add-new-record.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,15 +18,15 @@ unique type Foo = { bar : Nat } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = { bar : Nat } diff --git a/unison-src/transcripts/update-type-add-record-field.md b/unison-src/transcripts/update-type-add-record-field.md index ef5aba3614..d4edf079e1 100644 --- a/unison-src/transcripts/update-type-add-record-field.md +++ b/unison-src/transcripts/update-type-add-record-field.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,7 +15,7 @@ unique type Foo = { bar : Nat, baz : Int } ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-add-record-field.output.md b/unison-src/transcripts/update-type-add-record-field.output.md index 3f52ad6a82..23365f09b7 100644 --- a/unison-src/transcripts/update-type-add-record-field.output.md +++ b/unison-src/transcripts/update-type-add-record-field.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,8 +18,8 @@ unique type Foo = { bar : Nat } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -29,11 +29,11 @@ unique type Foo = { bar : Nat } Foo.bar.set : Nat -> Foo -> Foo ``` -```unison +``` unison unique type Foo = { bar : Nat, baz : Int } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,19 +56,19 @@ unique type Foo = { bar : Nat, baz : Int } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = { bar : Nat, baz : Int } -.> find.verbose +scratch/main> find.verbose 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 type Foo diff --git a/unison-src/transcripts/update-type-constructor-alias.md b/unison-src/transcripts/update-type-constructor-alias.md index 2d5f97ef25..50d55af066 100644 --- a/unison-src/transcripts/update-type-constructor-alias.md +++ b/unison-src/transcripts/update-type-constructor-alias.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> alias.term Foo.Bar Foo.BarAlias +scratch/main> add +scratch/main> alias.term Foo.Bar Foo.BarAlias ``` ```unison @@ -18,6 +18,6 @@ unique type Foo = Bar Nat Nat Bug: we leave `Foo.BarAlias` in the namespace with a nameless decl. ```ucm -.> update -.> find.verbose +scratch/main> update +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-constructor-alias.output.md b/unison-src/transcripts/update-type-constructor-alias.output.md index 44d683227c..e8d95fafe0 100644 --- a/unison-src/transcripts/update-type-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-constructor-alias.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,23 +15,23 @@ unique type Foo = Bar Nat type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo -.> alias.term Foo.Bar Foo.BarAlias +scratch/main> alias.term Foo.Bar Foo.BarAlias Done. ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,15 +47,15 @@ unique type Foo = Bar Nat Nat ``` Bug: we leave `Foo.BarAlias` in the namespace with a nameless decl. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> find.verbose +scratch/main> find.verbose 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g type Foo diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.md index b44cf8a7a7..3c7be50a53 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -14,7 +14,7 @@ foo = cases ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -23,5 +23,5 @@ unique type Foo ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md index 9966a32418..977866e321 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat | Baz Nat Nat @@ -9,7 +9,7 @@ foo = cases Baz n m -> n + m ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,8 +23,8 @@ foo = cases foo : Foo -> Nat ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -32,12 +32,12 @@ foo = cases foo : Foo -> Nat ``` -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,8 +51,8 @@ unique type Foo type Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -64,7 +64,7 @@ unique type Foo `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u foo : Foo -> Nat foo = cases Bar n -> n diff --git a/unison-src/transcripts/update-type-delete-constructor.md b/unison-src/transcripts/update-type-delete-constructor.md index cf348f690e..18a8295d5a 100644 --- a/unison-src/transcripts/update-type-delete-constructor.md +++ b/unison-src/transcripts/update-type-delete-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -9,7 +9,7 @@ unique type Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,7 +18,7 @@ unique type Foo ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-delete-constructor.output.md b/unison-src/transcripts/update-type-delete-constructor.output.md index c417d5f15c..31afdb7d41 100644 --- a/unison-src/transcripts/update-type-delete-constructor.output.md +++ b/unison-src/transcripts/update-type-delete-constructor.output.md @@ -1,10 +1,10 @@ -```unison +``` unison unique type Foo = Bar Nat | Baz Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,20 +17,20 @@ unique type Foo type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo ``` -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,19 +44,19 @@ unique type Foo type Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat -.> find.verbose +scratch/main> find.verbose 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 type Foo diff --git a/unison-src/transcripts/update-type-delete-record-field.md b/unison-src/transcripts/update-type-delete-record-field.md index de6396e0c3..cd3520e8b2 100644 --- a/unison-src/transcripts/update-type-delete-record-field.md +++ b/unison-src/transcripts/update-type-delete-record-field.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = { bar : Nat, baz : Int } ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,7 +17,7 @@ unique type Foo = { bar : Nat } We want the field accessors to go away; but for now they are here, causing the update to fail. ```ucm:error -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-delete-record-field.output.md b/unison-src/transcripts/update-type-delete-record-field.output.md index a5b570d6d4..876edca300 100644 --- a/unison-src/transcripts/update-type-delete-record-field.output.md +++ b/unison-src/transcripts/update-type-delete-record-field.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = { bar : Nat, baz : Int } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,8 +21,8 @@ unique type Foo = { bar : Nat, baz : Int } Foo.baz.set : Int -> Foo -> Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -35,11 +35,11 @@ unique type Foo = { bar : Nat, baz : Int } Foo.baz.set : Int -> Foo -> Foo ``` -```unison +``` unison unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,8 +58,8 @@ unique type Foo = { bar : Nat } ``` We want the field accessors to go away; but for now they are here, causing the update to fail. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -70,11 +70,11 @@ We want the field accessors to go away; but for now they are here, causing the u definitions that need fixing. Once the file is compiling, try `update` again. -.> view Foo +scratch/main> view Foo type Foo = { bar : Nat, baz : Int } -.> find.verbose +scratch/main> find.verbose 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 type Foo @@ -103,7 +103,7 @@ We want the field accessors to go away; but for now they are here, causing the u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u Foo.baz : Foo -> Int Foo.baz = cases Foo _ baz -> baz diff --git a/unison-src/transcripts/update-type-missing-constructor.md b/unison-src/transcripts/update-type-missing-constructor.md index bfaafa8343..5fa29c2a86 100644 --- a/unison-src/transcripts/update-type-missing-constructor.md +++ b/unison-src/transcripts/update-type-missing-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> delete.term Foo.Bar +scratch/main> add +scratch/main> delete.term Foo.Bar ``` Now we've set up a situation where the original constructor missing. @@ -18,6 +18,6 @@ unique type Foo = Bar Nat Nat ``` ```ucm:error -.> view Foo -.> update +scratch/main> view Foo +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index 52ead472eb..c9c8bc2eca 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,25 +15,25 @@ unique type Foo = Bar Nat type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo -.> delete.term Foo.Bar +scratch/main> delete.term Foo.Bar Done. ``` Now we've set up a situation where the original constructor missing. -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,12 +47,12 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm -.> view Foo +``` ucm +scratch/main> view Foo type Foo = #b509v3eg4k#0 Nat -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.md b/unison-src/transcripts/update-type-nested-decl-aliases.md index a51c9a2c16..03b20f6fd7 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -10,7 +10,7 @@ structural type A = B.TheOtherAlias Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,5 +22,5 @@ only one name for each constructor. We instead get too far in the update process file to stare at. ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.output.md b/unison-src/transcripts/update-type-nested-decl-aliases.output.md index 0b373c88cd..706efd6414 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.output.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.output.md @@ -1,11 +1,11 @@ -```unison +``` unison unique type Foo = Bar Nat structural type A.B = OneAlias Foo structural type A = B.TheOtherAlias Foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -20,8 +20,8 @@ structural type A = B.TheOtherAlias Foo type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -30,11 +30,11 @@ structural type A = B.TheOtherAlias Foo type Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -52,8 +52,8 @@ Bug: we want this update to be rejected earlier, because it violates the "decl c only one name for each constructor. We instead get too far in the update process, and are delivered a bogus scratch.u file to stare at. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -65,7 +65,7 @@ file to stare at. `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u structural type A = B.OneAlias Foo structural type A.B = OneAlias Foo diff --git a/unison-src/transcripts/update-type-no-op-record.md b/unison-src/transcripts/update-type-no-op-record.md index 50a559819a..e9ec904c95 100644 --- a/unison-src/transcripts/update-type-no-op-record.md +++ b/unison-src/transcripts/update-type-no-op-record.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,11 +7,11 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> add +scratch/main> add ``` Bug: this no-op update should (of course) succeed. ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-no-op-record.output.md b/unison-src/transcripts/update-type-no-op-record.output.md index 1a7e55eb74..763a1aba59 100644 --- a/unison-src/transcripts/update-type-no-op-record.output.md +++ b/unison-src/transcripts/update-type-no-op-record.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,8 +18,8 @@ unique type Foo = { bar : Nat } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -31,8 +31,8 @@ unique type Foo = { bar : Nat } ``` Bug: this no-op update should (of course) succeed. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.md b/unison-src/transcripts/update-type-stray-constructor-alias.md index 847a37e32d..8bd4ba3625 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> alias.term Foo.Bar Stray.BarAlias +scratch/main> add +scratch/main> alias.term Foo.Bar Stray.BarAlias ``` ```unison @@ -18,6 +18,6 @@ unique type Foo = Bar Nat Nat Bug: we leave `Stray.BarAlias` in the namespace with a nameless decl. ```ucm -.> update -.> find.verbose +scratch/main> update +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.output.md b/unison-src/transcripts/update-type-stray-constructor-alias.output.md index e9fe5f9662..c6f65667bf 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,23 +15,23 @@ unique type Foo = Bar Nat type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo -.> alias.term Foo.Bar Stray.BarAlias +scratch/main> alias.term Foo.Bar Stray.BarAlias Done. ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,15 +47,15 @@ unique type Foo = Bar Nat Nat ``` Bug: we leave `Stray.BarAlias` in the namespace with a nameless decl. -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> find.verbose +scratch/main> find.verbose 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g type Foo diff --git a/unison-src/transcripts/update-type-stray-constructor.md b/unison-src/transcripts/update-type-stray-constructor.md index 183818e564..7808f759be 100644 --- a/unison-src/transcripts/update-type-stray-constructor.md +++ b/unison-src/transcripts/update-type-stray-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> move.term Foo.Bar Stray.Bar +scratch/main> add +scratch/main> move.term Foo.Bar Stray.Bar ``` Now we've set up a situation where the constructor is not where it's supposed to be; it's somewhere else. @@ -20,6 +20,6 @@ unique type Foo = Bar Nat Nat Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. ```ucm:error -.> view Foo -.> update +scratch/main> view Foo +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index 8f72beefd3..4554fd53d3 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,25 +15,25 @@ unique type Foo = Bar Nat type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo -.> move.term Foo.Bar Stray.Bar +scratch/main> move.term Foo.Bar Stray.Bar Done. ``` Now we've set up a situation where the constructor is not where it's supposed to be; it's somewhere else. -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,12 +49,12 @@ unique type Foo = Bar Nat Nat ``` Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. -```ucm -.> view Foo +``` ucm +scratch/main> view Foo type Foo = Stray.Bar Nat -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md index 1debc0aaf3..1f2933242a 100644 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md +++ b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -10,7 +10,7 @@ makeFoo n = Bar (n+10) ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -21,7 +21,7 @@ Foo.Bar n = internal.Bar n ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md index a28e27e747..b6daa83021 100644 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md +++ b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md @@ -1,11 +1,11 @@ -```unison +``` unison unique type Foo = Bar Nat makeFoo : Nat -> Foo makeFoo n = Bar (n+10) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,8 +19,8 @@ makeFoo n = Bar (n+10) makeFoo : Nat -> Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -28,14 +28,14 @@ makeFoo n = Bar (n+10) makeFoo : Nat -> Foo ``` -```unison +``` unison unique type Foo = internal.Bar Nat Foo.Bar : Nat -> Foo Foo.Bar n = internal.Bar n ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,8 +50,8 @@ Foo.Bar n = internal.Bar n Foo.Bar : Nat -> Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -62,11 +62,11 @@ Foo.Bar n = internal.Bar n Done. -.> view Foo +scratch/main> view Foo type Foo = internal.Bar Nat -.> find.verbose +scratch/main> find.verbose 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 type Foo diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.md b/unison-src/transcripts/update-type-turn-non-record-into-record.md index b570aa5f7e..829240ff62 100644 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.md +++ b/unison-src/transcripts/update-type-turn-non-record-into-record.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = Nat ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,7 +15,7 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md index f23ab09cd5..edeb85642e 100644 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md +++ b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md @@ -1,8 +1,8 @@ -```unison +``` unison unique type Foo = Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,19 +15,19 @@ unique type Foo = Nat type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: type Foo ``` -```unison +``` unison unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,19 +47,19 @@ unique type Foo = { bar : Nat } type Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = { bar : Nat } -.> find.verbose +scratch/main> find.verbose 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 type Foo diff --git a/unison-src/transcripts/update-type-with-dependent-term.md b/unison-src/transcripts/update-type-with-dependent-term.md index 99bfcceac4..300eddc69f 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.md +++ b/unison-src/transcripts/update-type-with-dependent-term.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -10,7 +10,7 @@ incrFoo = cases Bar n -> Bar (n+1) ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,5 +18,5 @@ unique type Foo = Bar Nat Nat ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-with-dependent-term.output.md b/unison-src/transcripts/update-type-with-dependent-term.output.md index e8837eb523..b5db3f2646 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.output.md +++ b/unison-src/transcripts/update-type-with-dependent-term.output.md @@ -1,11 +1,11 @@ -```unison +``` unison unique type Foo = Bar Nat incrFoo : Foo -> Foo incrFoo = cases Bar n -> Bar (n+1) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,8 +19,8 @@ incrFoo = cases Bar n -> Bar (n+1) incrFoo : Foo -> Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -28,11 +28,11 @@ incrFoo = cases Bar n -> Bar (n+1) incrFoo : Foo -> Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -46,8 +46,8 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -59,7 +59,7 @@ unique type Foo = Bar Nat Nat `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u incrFoo : Foo -> Foo incrFoo = cases Bar n -> Bar (n Nat.+ 1) diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md index 7c5a5018b2..1caef319d8 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -8,7 +8,7 @@ unique type Baz = Qux Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -16,5 +16,5 @@ unique type Foo a = Bar Nat a ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md index e105b39ea2..8ffbf3b88f 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md @@ -1,9 +1,9 @@ -```unison +``` unison unique type Foo = Bar Nat unique type Baz = Qux Foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,8 +17,8 @@ unique type Baz = Qux Foo type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -26,11 +26,11 @@ unique type Baz = Qux Foo type Foo ``` -```unison +``` unison unique type Foo a = Bar Nat a ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,8 +44,8 @@ unique type Foo a = Bar Nat a type Foo a ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -57,7 +57,7 @@ unique type Foo a = Bar Nat a `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u type Baz = Qux Foo type Foo a = Bar Nat a diff --git a/unison-src/transcripts/update-type-with-dependent-type.md b/unison-src/transcripts/update-type-with-dependent-type.md index 7dea367322..4b6e8aa2dc 100644 --- a/unison-src/transcripts/update-type-with-dependent-type.md +++ b/unison-src/transcripts/update-type-with-dependent-type.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -8,7 +8,7 @@ unique type Baz = Qux Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -16,8 +16,8 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> update -.> view Foo -.> view Baz -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> view Baz +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-with-dependent-type.output.md b/unison-src/transcripts/update-type-with-dependent-type.output.md index 47988e1ffd..6effd150c3 100644 --- a/unison-src/transcripts/update-type-with-dependent-type.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type.output.md @@ -1,9 +1,9 @@ -```unison +``` unison unique type Foo = Bar Nat unique type Baz = Qux Foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,8 +17,8 @@ unique type Baz = Qux Foo type Foo ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: @@ -26,11 +26,11 @@ unique type Baz = Qux Foo type Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,8 +44,8 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -56,15 +56,15 @@ unique type Foo = Bar Nat Nat Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat Nat -.> view Baz +scratch/main> view Baz type Baz = Qux Foo -.> find.verbose +scratch/main> find.verbose 1. -- #34msh9satlfog576493eo9pkjn6aj7d8fj6jfheglvgr5s39iptb81649bpkad1lqraheqb8em9ms551k01oternhknc4m7jicgtk08 type Baz diff --git a/unison-src/transcripts/update-watch.md b/unison-src/transcripts/update-watch.md index 6637515ff6..013801ebb7 100644 --- a/unison-src/transcripts/update-watch.md +++ b/unison-src/transcripts/update-watch.md @@ -3,5 +3,5 @@ ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-watch.output.md b/unison-src/transcripts/update-watch.output.md index e97d32f9ef..feb53dc173 100644 --- a/unison-src/transcripts/update-watch.output.md +++ b/unison-src/transcripts/update-watch.output.md @@ -1,8 +1,8 @@ -```unison +``` unison > 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,8 +18,8 @@ 1 ``` -```ucm -.> update +``` ucm +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/upgrade-happy-path.output.md b/unison-src/transcripts/upgrade-happy-path.output.md index b2d8bb80a6..127b0c4897 100644 --- a/unison-src/transcripts/upgrade-happy-path.output.md +++ b/unison-src/transcripts/upgrade-happy-path.output.md @@ -1,10 +1,10 @@ -```unison +``` unison lib.old.foo = 17 lib.new.foo = 18 thingy = lib.old.foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ thingy = lib.old.foo + 10 thingy : Nat ``` -```ucm +``` ucm proj/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ proj/main> add ``` Test tab completion and fzf options of upgrade command. -```ucm +``` ucm proj/main> debug.tab-complete upgrade ol old @@ -51,7 +51,7 @@ proj/main> debug.fuzzy-options upgrade old _ * old ``` -```ucm +``` ucm proj/main> upgrade old new I upgraded old to new, and removed old. diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index f0811cd8ee..54c7b546c1 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -1,10 +1,10 @@ -```unison +``` unison lib.old.foo = 17 lib.new.foo = +18 thingy = lib.old.foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ thingy = lib.old.foo + 10 thingy : Nat ``` -```ucm +``` ucm proj/main> add ⍟ I've added these definitions: @@ -29,7 +29,7 @@ proj/main> add thingy : Nat ``` -```ucm +``` ucm proj/main> upgrade old new I couldn't automatically upgrade old to new. However, I've @@ -49,7 +49,7 @@ proj/main> upgrade old new to delete the temporary branch and switch back to main. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u thingy : Nat thingy = use Nat + @@ -58,11 +58,11 @@ thingy = Resolve the error and commit the upgrade. -```unison +``` unison thingy = foo + +10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -76,7 +76,7 @@ thingy = foo + +10 thingy : Int ``` -```ucm +``` ucm proj/upgrade-old-to-new> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/upgrade-suffixifies-properly.output.md b/unison-src/transcripts/upgrade-suffixifies-properly.output.md index 4b7b313199..0440acc2ac 100644 --- a/unison-src/transcripts/upgrade-suffixifies-properly.output.md +++ b/unison-src/transcripts/upgrade-suffixifies-properly.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.old.foo = 25 lib.new.foo = +30 a.x.x.x.x = 100 @@ -8,7 +8,7 @@ d.y.y.y.y = lib.old.foo + 10 bar = a.x.x.x.x + c.y.y.y.y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,7 +27,7 @@ bar = a.x.x.x.x + c.y.y.y.y lib.old.foo : Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: @@ -41,7 +41,7 @@ myproject/main> add lib.old.foo : Nat ``` -```ucm +``` ucm myproject/main> upgrade old new I couldn't automatically upgrade old to new. However, I've @@ -61,7 +61,7 @@ myproject/main> upgrade old new to delete the temporary branch and switch back to main. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Nat bar = use Nat + diff --git a/unison-src/transcripts/upgrade-with-old-alias.output.md b/unison-src/transcripts/upgrade-with-old-alias.output.md index 9fdea6d7bd..9afef6c22b 100644 --- a/unison-src/transcripts/upgrade-with-old-alias.output.md +++ b/unison-src/transcripts/upgrade-with-old-alias.output.md @@ -1,11 +1,11 @@ -```unison +``` unison lib.old.foo = 141 lib.new.foo = 142 bar = 141 mything = lib.old.foo + 100 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ mything = lib.old.foo + 100 mything : Nat ``` -```ucm +``` ucm myproject/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/view.md index 89b81cf51f..5c2b0e8c58 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/view.md @@ -1,7 +1,7 @@ # View commands ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -10,16 +10,22 @@ b.thing = "b" ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -- Should suffix-search and find values in sub-namespaces -.> view thing --- Should be local to namespace -.a> view thing +scratch/main> view thing +-- Should support absolute paths +scratch/main> view .b.thing +``` + + +TODO: swap this back to a 'ucm' block when view.global is re-implemented + +``` -- view.global should search globally and be absolutely qualified -.a> view.global thing --- Should support absolute paths outside of current namespace -.a> view .b.thing +scratch/other> view.global thing +-- Should support branch relative paths +scratch/other> view /main:a.thing ``` diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index 71ebf98da7..336a8c932e 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -1,13 +1,13 @@ # View commands -```unison +``` unison a.thing = "a" b.thing = "b" ``` -```ucm +``` ucm -- Should suffix-search and find values in sub-namespaces -.> view thing +scratch/main> view thing a.thing : Text a.thing = "a" @@ -15,25 +15,19 @@ b.thing = "b" b.thing : Text b.thing = "b" --- Should be local to namespace -.a> view thing +-- Should support absolute paths +scratch/main> view .b.thing - thing : ##Text - thing = "a" - --- view.global should search globally and be absolutely qualified -.a> view.global thing - - .a.thing : Text - .a.thing = "a" - .b.thing : Text .b.thing = "b" --- Should support absolute paths outside of current namespace -.a> view .b.thing - - .b.thing : Text - .b.thing = "b" +``` +TODO: swap this back to a 'ucm' block when view.global is re-implemented +``` +-- view.global should search globally and be absolutely qualified +scratch/other> view.global thing +-- Should support branch relative paths +scratch/other> view /main:a.thing ``` + diff --git a/unison-src/transcripts/watch-expressions.md b/unison-src/transcripts/watch-expressions.md index e17d789a55..b4f54004b0 100644 --- a/unison-src/transcripts/watch-expressions.md +++ b/unison-src/transcripts/watch-expressions.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -7,7 +7,7 @@ test> pass = [Ok "Passed"] ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,8 +15,8 @@ test> pass = [Ok "Passed"] ``` ```ucm -.> add -.> test +scratch/main> add +scratch/main> test ``` ```unison diff --git a/unison-src/transcripts/watch-expressions.output.md b/unison-src/transcripts/watch-expressions.output.md index 3a12bbcac7..096f08e7a3 100644 --- a/unison-src/transcripts/watch-expressions.output.md +++ b/unison-src/transcripts/watch-expressions.output.md @@ -1,14 +1,14 @@ -```ucm -.> builtins.mergeio +``` ucm +scratch/main> builtins.mergeio Done. ``` -```unison +``` unison test> pass = [Ok "Passed"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,19 +28,19 @@ test> pass = [Ok "Passed"] ✅ Passed Passed ``` -```ucm -.> add +``` ucm +scratch/main> add ⍟ I've added these definitions: pass : [Result] ``` -```unison +``` unison test> pass = [Ok "Passed"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -55,28 +55,28 @@ test> pass = [Ok "Passed"] ✅ Passed Passed (cached) ``` -```ucm -.> add +``` ucm +scratch/main> add ⊡ Ignored previously added definitions: pass -.> test +scratch/main> test Cached test results (`help testcache` to learn more) - ◉ pass Passed + 1. pass ◉ Passed ✅ 1 test(s) passing - Tip: Use view pass to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison > ImmutableArray.fromList [?a, ?b, ?c] > ImmutableByteArray.fromBytes 0xs123456 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-syntax/src/Unison/Lexer/Pos.hs b/unison-syntax/src/Unison/Lexer/Pos.hs index b3297b9221..e78bb61c88 100644 --- a/unison-syntax/src/Unison/Lexer/Pos.hs +++ b/unison-syntax/src/Unison/Lexer/Pos.hs @@ -4,21 +4,13 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} -module Unison.Lexer.Pos (Pos (..), Line, Column, line, column) where +module Unison.Lexer.Pos (Pos (..), Line, Column) where type Line = Int type Column = Int -data Pos = Pos {-# UNPACK #-} !Line {-# UNPACK #-} !Column deriving (Eq, Ord) - -line :: Pos -> Line -line (Pos line _) = line - -column :: Pos -> Column -column (Pos _ column) = column - -instance Show Pos where show (Pos line col) = "line " <> show line <> ", column " <> show col +data Pos = Pos {line :: {-# UNPACK #-} !Line, column :: {-# UNPACK #-} !Column} deriving (Show, Eq, Ord) instance Semigroup Pos where Pos line col <> Pos line2 col2 = diff --git a/unison-syntax/src/Unison/Syntax/HashQualified.hs b/unison-syntax/src/Unison/Syntax/HashQualified.hs index e90d8c6cb7..9cc25f61cc 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualified.hs @@ -21,10 +21,10 @@ import Text.Megaparsec qualified as P import Text.Megaparsec.Internal qualified as P (withParsecT) import Unison.HashQualified (HashQualified (..)) import Unison.HashQualified qualified as HashQualified -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Prelude hiding (fromString) -import Unison.Syntax.HashQualified' qualified as HQ' +import Unison.Syntax.HashQualifiedPrime qualified as HQ' import Unison.Syntax.Lexer.Token (Token) import Unison.Syntax.Name qualified as Name (nameP, toText) import Unison.Syntax.NameSegment qualified as NameSegment @@ -66,7 +66,7 @@ toVar = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HashQualified name) hashQualifiedP nameP = diff --git a/unison-syntax/src/Unison/Syntax/HashQualified'.hs b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs similarity index 94% rename from unison-syntax/src/Unison/Syntax/HashQualified'.hs rename to unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs index de5c4bfeab..406a8eae2f 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified'.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Syntax-related combinators for HashQualified' (to/from string types). -module Unison.Syntax.HashQualified' +module Unison.Syntax.HashQualifiedPrime ( -- * String conversions parseText, unsafeParseText, @@ -16,7 +16,7 @@ import Data.Text qualified as Text import Text.Megaparsec (ParsecT) import Text.Megaparsec qualified as P import Text.Megaparsec.Internal qualified as P (withParsecT) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Prelude hiding (fromString) import Unison.Syntax.Lexer.Token (Token) @@ -48,7 +48,7 @@ toText = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HQ'.HashQualified name) hashQualifiedP nameP = diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 1c85ee2519..d47d471abc 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -8,8 +8,6 @@ module Unison.Syntax.Lexer Pos (..), Lexeme (..), lexer, - line, - column, escapeChars, debugFileLex, debugLex', @@ -46,7 +44,7 @@ import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Text.Megaparsec.Error qualified as EP import Text.Megaparsec.Internal qualified as PI -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Lexer.Pos (Column, Line, Pos (Pos), column, line) import Unison.Name (Name) import Unison.Name qualified as Name @@ -56,7 +54,7 @@ import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP) import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar) @@ -71,11 +69,18 @@ type BlockName = String type Layout = [(BlockName, Column)] data ParsingEnv = ParsingEnv - { layout :: !Layout, -- layout stack - opening :: Maybe BlockName, -- `Just b` if a block of type `b` is being opened - inLayout :: Bool, -- are we inside a construct that uses layout? - parentSection :: Int, -- 1 means we are inside a # Heading 1 - parentListColumn :: Int -- 4 means we are inside a list starting at the fourth column + { -- layout stack + layout :: !Layout, + -- `Just b` if a block of type `b` is being opened + opening :: Maybe BlockName, + -- are we inside a construct that uses layout? + inLayout :: Bool, + -- Use a stack to remember the parent section and + -- allow docSections within docSections. + -- 1 means we are inside a # Heading 1 + parentSections :: [Int], + -- 4 means we are inside a list starting at the fourth column + parentListColumn :: Int } deriving (Show) @@ -95,8 +100,7 @@ parseFailure :: EP.ParseError [Char] (Token Err) -> P a parseFailure e = PI.ParsecT $ \s _ _ _ eerr -> eerr e s data Err - = InvalidWordyId String - | ReservedWordyId String + = ReservedWordyId String | InvalidSymbolyId String | ReservedSymbolyId String | InvalidShortHash String @@ -309,7 +313,7 @@ lexer0' scope rem = (P.EndOfInput) -> "end of input" customErrs es = [Err <$> e | P.ErrorCustom e <- toList es] toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col) - env0 = ParsingEnv [] (Just scope) True 0 0 + env0 = ParsingEnv [] (Just scope) True [0] 0 -- hacky postprocessing pass to do some cleanup of stuff that's annoying to -- fix without adding more state to the lexer: -- - 1+1 lexes as [1, +1], convert this to [1, +, 1] @@ -428,13 +432,20 @@ lexemes' eof = -- Construct the token for opening the doc block. let openTok = Token (Open "syntax.docUntitledSection") openStart openEnd env0 <- S.get - -- Disable layout while parsing the doc block - (bodyToks0, closeTok) <- local (\env -> env {inLayout = False}) do - bodyToks <- body - closeStart <- posP - lit "}}" - closeEnd <- posP - pure (bodyToks, Token Close closeStart closeEnd) + -- Disable layout while parsing the doc block and reset the section number + (bodyToks0, closeTok) <- local + ( \env -> + env + { inLayout = False, + parentSections = 0 : (parentSections env0) + } + ) + do + bodyToks <- body + closeStart <- posP + lit "}}" + closeEnd <- posP + pure (bodyToks, Token Close closeStart closeEnd) let docToks = beforeStartToks <> [openTok] <> bodyToks0 <> [closeTok] -- Parse any layout tokens after the doc block, e.g. virtual semicolon endToks <- token' ignore (pure ()) @@ -813,12 +824,12 @@ lexemes' eof = -- # A section title (not a subsection) section :: P [Token Lexeme] section = wrap "syntax.docSection" $ do - n <- S.gets parentSection - hashes <- P.try $ lit (replicate n '#') *> P.takeWhile1P Nothing (== '#') <* sp + ns <- S.gets parentSections + hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp title <- paragraph <* CP.space - let m = length hashes + n + let m = length hashes + head ns body <- - local (\env -> env {parentSection = m}) $ + local (\env -> env {parentSections = (m : (tail ns))}) $ P.many (sectionElem <* CP.space) pure $ title <> join body diff --git a/unison-syntax/src/Unison/Syntax/Name.hs b/unison-syntax/src/Unison/Syntax/Name.hs index 17112b6b95..a0de444b2b 100644 --- a/unison-syntax/src/Unison/Syntax/Name.hs +++ b/unison-syntax/src/Unison/Syntax/Name.hs @@ -85,7 +85,7 @@ toText (Name pos (x0 :| xs)) = Relative -> "" -- | Parse a name from a var, by first rendering the var as a string. -parseVar :: Var v => v -> Maybe Name +parseVar :: (Var v) => v -> Maybe Name parseVar = parseText . Var.name @@ -105,7 +105,7 @@ toVar = -- Name parsers -- | A name parser. -nameP :: Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name +nameP :: (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name nameP = P.try do leadingDot <- isJust <$> P.optional (P.char '.') @@ -113,7 +113,7 @@ nameP = pure (if leadingDot then Name.makeAbsolute name else name) -- | A relative name parser. -relativeNameP :: forall m. Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name +relativeNameP :: forall m. (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name relativeNameP = do Name.fromSegments <$> Monad.sepBy1 NameSegment.segmentP separatorP where @@ -123,7 +123,7 @@ relativeNameP = do -- This allows (for example) the "a." in "forall a. a -> a" to successfully parse as an identifier "a" followed by -- the reserved symbol ".", rathern than fail to parse as an identifier, because it looks like the prefix of some -- "a.b" that stops in the middle. - separatorP :: Ord e => ParsecT e [Char] m Char + separatorP :: (Ord e) => ParsecT e [Char] m Char separatorP = P.try do c <- P.char '.' diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 28bbdf042e..affab5bf2c 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -39,6 +39,7 @@ module Unison.Syntax.Parser run, semi, Unison.Syntax.Parser.seq, + Unison.Syntax.Parser.seq', sepBy, sepBy1, string, @@ -71,7 +72,7 @@ import Unison.ABT qualified as ABT import Unison.ConstructorReference (ConstructorReference) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashable qualified as Hashable import Unison.Name as Name import Unison.Names (Names) @@ -279,7 +280,7 @@ semi = label "newline or semicolon" $ queryToken go closeBlock :: (Ord v) => P v m (L.Token ()) closeBlock = void <$> matchToken L.Close -wordyPatternName :: Var v => P v m (L.Token v) +wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n _ -> Nothing @@ -303,27 +304,27 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName _ -> Nothing -- Parse a wordy identifier e.g. Foo, discarding any hash -wordyDefinitionName :: Var v => P v m (L.Token v) +wordyDefinitionName :: (Var v) => P v m (L.Token v) wordyDefinitionName = queryToken $ \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing -- Parse a wordyId as a Name, rejecting any hash -importWordyId :: Ord v => P v m (L.Token Name) +importWordyId :: (Ord v) => P v m (L.Token Name) importWordyId = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just n L.Blank s | not (null s) -> Just $ Name.unsafeParseText (Text.pack ("_" <> s)) _ -> Nothing -- The `+` in: use Foo.bar + as a Name -importSymbolyId :: Ord v => P v m (L.Token Name) +importSymbolyId :: (Ord v) => P v m (L.Token Name) importSymbolyId = queryToken \case L.SymbolyId (HQ'.NameOnly n) -> Just n _ -> Nothing -- Parse a symboly ID like >>= or &&, discarding any hash -symbolyDefinitionName :: Var v => P v m (L.Token v) +symbolyDefinitionName :: (Var v) => P v m (L.Token v) symbolyDefinitionName = queryToken $ \case L.SymbolyId n -> Just $ Name.toVar (HQ'.toName n) _ -> Nothing @@ -344,7 +345,7 @@ hqPrefixId = hqWordyId_ <|> parenthesize hqSymbolyId_ hqInfixId = hqSymbolyId_ -- Parse a hash-qualified alphanumeric identifier -hqWordyId_ :: Ord v => P v m (L.Token (HQ.HashQualified Name)) +hqWordyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqWordyId_ = queryToken \case L.WordyId n -> Just $ HQ'.toHQ n L.Hash h -> Just $ HQ.HashOnly h @@ -352,7 +353,7 @@ hqWordyId_ = queryToken \case _ -> Nothing -- Parse a hash-qualified symboly ID like >>=#foo or && -hqSymbolyId_ :: Ord v => P v m (L.Token (HQ.HashQualified Name)) +hqSymbolyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqSymbolyId_ = queryToken \case L.SymbolyId n -> Just (HQ'.toHQ n) _ -> Nothing @@ -408,7 +409,7 @@ string = queryToken getString -- -- returns the result of combining elements with 'pair', alongside the annotation containing -- the full parenthesized expression. -tupleOrParenthesized :: Ord v => P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann {- spanAnn -}, a) +tupleOrParenthesized :: (Ord v) => P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann {- spanAnn -}, a) tupleOrParenthesized p unit pair = do seq' "(" go p where diff --git a/unison-syntax/test/Main.hs b/unison-syntax/test/Main.hs index 3b3319567d..bd40c7ded8 100644 --- a/unison-syntax/test/Main.hs +++ b/unison-syntax/test/Main.hs @@ -9,7 +9,7 @@ import System.IO.CodePage (withCP65001) import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as ShortHash -import Unison.Syntax.HashQualified' qualified as HQ' (unsafeParseText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (unsafeParseText) import Unison.Syntax.Lexer main :: IO () diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 9c3241e394..888982134f 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -20,7 +20,7 @@ library Unison.Lexer.Pos Unison.Parser.Ann Unison.Syntax.HashQualified - Unison.Syntax.HashQualified' + Unison.Syntax.HashQualifiedPrime Unison.Syntax.Lexer Unison.Syntax.Lexer.Token Unison.Syntax.Name