Merge pull request #8 from unisoncomputing/cp/bump-trunk-june-28

Bump unison trunk

src/Share/Backend.hs

@@ -61,7 +61,7 @@ import Unison.ConstructorType qualified as CT
 import Unison.DataDeclaration qualified as DD
 import Unison.Hashing.V2.Convert qualified as Hashing
 import Unison.Name qualified as Name
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment.Internal (NameSegment (..))
 import Unison.Parser.Ann (Ann)
 import Unison.PrettyPrintEnv qualified as PPE
 import Unison.PrettyPrintEnvDecl qualified as PPED
@@ -143,7 +143,7 @@ mkTermDefinition termPPED width r docs tm = do
           docs
 
 termListEntry ::
-  PG.QueryM m =>
+  (PG.QueryM m) =>
   Type Symbol Ann ->
   ExactName NameSegment V2Referent.Referent ->
   m (Backend.TermEntry Symbol Ann)
@@ -161,7 +161,7 @@ termListEntry typ (ExactName nameSegment ref) = do
       }
 
 typeListEntry ::
-  PG.QueryM m =>
+  (PG.QueryM m) =>
   ExactName NameSegment Reference ->
   m Backend.TypeEntry
 typeListEntry (ExactName nameSegment ref) = do
@@ -193,14 +193,14 @@ getTermTag r termType = do
     V2Referent.Con ref _ -> Just <$> Codebase.expectDeclKind 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 ::
-  PG.QueryM m =>
+  (PG.QueryM m) =>
   Reference.TypeReference ->
   m TypeTag
 getTypeTag r = do

src/Share/Codebase/Types.hs

@@ -19,9 +19,10 @@ import Unison.Codebase.Runtime qualified as Rt
 import Unison.Parser.Ann (Ann)
 import Unison.Reference qualified as Reference
 import Unison.Symbol (Symbol)
+import Unison.NameSegment.Internal (NameSegment (..))
 
 publicRoot :: Path.Path
-publicRoot = Path.singleton "public"
+publicRoot = Path.singleton $ NameSegment "public"
 
 -- | The scope of a given codebase transaction.
 data CodebaseEnv = CodebaseEnv

src/Share/Postgres/Causal/Queries.hs

@@ -56,7 +56,7 @@ import Unison.Codebase.Path qualified as Path
 import Unison.Hash (Hash)
 import Unison.Hash32 (Hash32)
 import Unison.Hashing.V2 qualified as H
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment.Internal (NameSegment (..))
 import Unison.Reference qualified as Reference
 import Unison.Util.Map qualified as Map
 
@@ -95,12 +95,12 @@ loadPgCausalNamespace causalId = runMaybeT $ do
                       AND EXISTS (SELECT FROM causal_ownership o WHERE o.causal_id = ca.ancestor_id AND o.user_id = #{codebaseOwner})
             |]
 
-expectPgCausalNamespace :: HasCallStack => CausalId -> CodebaseM e (PgCausalNamespace (CodebaseM e))
+expectPgCausalNamespace :: (HasCallStack) => CausalId -> CodebaseM e (PgCausalNamespace (CodebaseM e))
 expectPgCausalNamespace causalId =
   loadPgCausalNamespace causalId
     `whenNothingM` unrecoverableError (MissingExpectedEntity $ "Expected causal branch for causal: " <> tShow causalId)
 
-loadCausalNamespace :: forall m. QueryM m => CausalId -> m (Maybe (CausalNamespace m))
+loadCausalNamespace :: forall m. (QueryM m) => CausalId -> m (Maybe (CausalNamespace m))
 loadCausalNamespace causalId = runMaybeT $ do
   causalHash <- HashQ.expectCausalHashesByIdsOf id causalId
   branchHashId <- HashQ.expectNamespaceIdsByCausalIdsOf id causalId
@@ -141,7 +141,7 @@ expectNamespaceHashByCausalHash causalHash = do
                 AND EXISTS (SELECT FROM causal_ownership o WHERE o.causal_id = causals.id AND o.user_id = #{codebaseOwner})
     |]
 
-expectNamespace :: forall m. QueryM m => BranchHashId -> m (Branch m)
+expectNamespace :: forall m. (QueryM m) => BranchHashId -> m (Branch m)
 expectNamespace branchHashId = do
   termsAndConstructors <- getTermsAndConstructors branchHashId <&> (traversed . traversed %~ loadTermMetadata)
   types <- getTypes branchHashId <&> (traversed . traversed %~ loadTypeMetadata)
@@ -224,7 +224,7 @@ expectNamespace branchHashId = do
           )
         <&> Map.fromList
 
-    getChildren :: QueryM m => BranchHashId -> m (Map NameSegment (CausalBranch m))
+    getChildren :: (QueryM m) => BranchHashId -> m (Map NameSegment (CausalBranch m))
     getChildren branchHashId = do
       childIds <-
         queryListRows
@@ -402,7 +402,7 @@ expectNamespaceIdForCausal c = do
 -- | Crawls the namespace tree to find the causal id mounted at a given path from the provided
 -- root causal.
 -- Returns Nothing if there's no causal at the provided path (or if the root causal doesn't exist)
-loadCausalIdAtPath :: HasCallStack => CausalId -> Path.Path -> CodebaseM e (Maybe CausalId)
+loadCausalIdAtPath :: (HasCallStack) => CausalId -> Path.Path -> CodebaseM e (Maybe CausalId)
 loadCausalIdAtPath rootCausalId path = runMaybeT $ do
   codebaseOwner <- asks Codebase.codebaseOwner
   let pathArray = Path.toList path
@@ -414,7 +414,7 @@ loadCausalIdAtPath rootCausalId path = runMaybeT $ do
         WHERE EXISTS (SELECT FROM causal_ownership o WHERE o.causal_id = causal_id AND o.user_id = #{codebaseOwner})
     |]
 
-loadCausalNamespaceAtPath :: HasCallStack => CausalId -> Path.Path -> CodebaseM e (Maybe (CausalNamespace (CodebaseM e)))
+loadCausalNamespaceAtPath :: (HasCallStack) => CausalId -> Path.Path -> CodebaseM e (Maybe (CausalNamespace (CodebaseM e)))
 loadCausalNamespaceAtPath causalId path = do
   causalId <- loadCausalIdAtPath causalId path
   traverse expectCausalNamespace causalId
@@ -794,7 +794,7 @@ saveV2BranchShallow v2Branch = do
     mdValuesToMetadataSetFormat (V2.MdValues meta) = BranchFull.Inline meta
 
 -- | Get the namespace stats of a namespace.
-expectNamespaceStatsOf :: QueryM m => Traversal s t BranchHash NamespaceStats -> s -> m t
+expectNamespaceStatsOf :: (QueryM m) => Traversal s t BranchHash NamespaceStats -> s -> m t
 expectNamespaceStatsOf trav s =
   s
     & unsafePartsOf trav %%~ \branchHashes -> do
@@ -889,7 +889,7 @@ importAccessibleCausals causalHashes = do
   pure results
 
 -- | Find the best common ancestor between two causals for diffs or merges.
-bestCommonAncestor :: QueryM m => CausalId -> CausalId -> m (Maybe CausalId)
+bestCommonAncestor :: (QueryM m) => CausalId -> CausalId -> m (Maybe CausalId)
 bestCommonAncestor a b = do
   query1Col
     [sql| SELECT best_common_causal_ancestor(#{a}, #{b}) as causal_id

src/Share/Postgres/NameLookups/Ops.hs

@@ -34,7 +34,8 @@ import Unison.Codebase.Path qualified as Path
 import Unison.Debug qualified as Debug
 import Unison.Name (Name)
 import Unison.Name qualified as Name
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment.Internal (NameSegment (..))
+import Unison.NameSegment.Internal qualified as NameSegment
 import Unison.Reference qualified as V1
 import Unison.Referent qualified as V1
 import Unison.Util.List qualified as List
@@ -49,7 +50,7 @@ import Unison.Util.List qualified as List
 --
 -- Or if your namespace is "subnamespace.user", you'd get back
 -- (the rootBranchId you provided, "", "subnamespace.user")
-namesPerspectiveForRootAndPath :: forall m. PG.QueryM m => BranchHashId -> PathSegments -> m NamesPerspective
+namesPerspectiveForRootAndPath :: forall m. (PG.QueryM m) => BranchHashId -> PathSegments -> m NamesPerspective
 namesPerspectiveForRootAndPath rootBranchHashId namespace = do
   nameLookupReceipt <- ensureNameLookupForBranchId rootBranchHashId
   namesPerspectiveForRootAndPathHelper nameLookupReceipt rootBranchHashId namespace
@@ -102,14 +103,14 @@ relocateToNameRoot perspective query rootBh = do
         Nothing -> Path.empty
   let fullPath = perspective <> nameLocation
   Debug.debugM Debug.Server "relocateToNameRoot fullPath" fullPath
-  namesPerspective@NamesPerspective {relativePerspective} <- namesPerspectiveForRootAndPath rootBh (PathSegments . coerce . Path.toList $ fullPath)
+  namesPerspective@NamesPerspective {relativePerspective} <- namesPerspectiveForRootAndPath rootBh (PathSegments . fmap NameSegment.toUnescapedText . Path.toList $ fullPath)
   let reprefixName name = Name.fromReverseSegments $ (NonEmpty.head $ Name.reverseSegments name) NonEmpty.:| (reverse $ coerce relativePerspective)
   pure (namesPerspective, reprefixName <$> query)
 
 -- | Search for term or type names which contain the provided list of segments in order.
 -- Search is case insensitive.
 fuzzySearchDefinitions ::
-  PG.QueryM m =>
+  (PG.QueryM m) =>
   Bool ->
   NamesPerspective ->
   -- | Will return at most n terms and n types; i.e. max number of results is 2n
@@ -132,20 +133,20 @@ fuzzySearchDefinitions includeDependencies NamesPerspective {nameLookupBranchHas
   pure (termNames, typeNames)
 
 -- | Get the list of (fqn, suffixified) names for a given Referent.
-termNamesForRefWithinNamespace :: PG.QueryM m => NamesPerspective -> PGReferent -> Maybe ReversedName -> m [(ReversedName {- fqn -}, ReversedName {- suffixified -})]
+termNamesForRefWithinNamespace :: (PG.QueryM m) => NamesPerspective -> PGReferent -> Maybe ReversedName -> m [(ReversedName {- fqn -}, ReversedName {- suffixified -})]
 termNamesForRefWithinNamespace NamesPerspective {nameLookupBranchHashId, pathToMountedNameLookup, nameLookupReceipt} ref maySuffix = do
   NameLookupQ.termNamesForRefWithinNamespace nameLookupReceipt nameLookupBranchHashId mempty ref maySuffix
     <&> fmap (first $ prefixReversedName pathToMountedNameLookup)
 
 -- | Get the list of (fqn, suffixified) names for a given Reference.
-typeNamesForRefWithinNamespace :: PG.QueryM m => NamesPerspective -> PGReference -> Maybe ReversedName -> m [(ReversedName {- fqn -}, ReversedName {- suffixified -})]
+typeNamesForRefWithinNamespace :: (PG.QueryM m) => NamesPerspective -> PGReference -> Maybe ReversedName -> m [(ReversedName {- fqn -}, ReversedName {- suffixified -})]
 typeNamesForRefWithinNamespace NamesPerspective {nameLookupBranchHashId, pathToMountedNameLookup, nameLookupReceipt} ref maySuffix = do
   NameLookupQ.typeNamesForRefWithinNamespace nameLookupReceipt nameLookupBranchHashId mempty ref maySuffix
     <&> fmap (first $ prefixReversedName pathToMountedNameLookup)
 
 -- | Helper for findings refs by name within the correct mounted indexes.
 refsForExactName ::
-  PG.QueryM m =>
+  (PG.QueryM m) =>
   (NameLookupReceipt -> BranchHashId -> ReversedName -> m [NamedRef ref]) ->
   NamesPerspective ->
   ReversedName ->
@@ -156,18 +157,18 @@ refsForExactName query NamesPerspective {nameLookupBranchHashId, pathToMountedNa
     namedRefs
       <&> prefixNamedRef pathToMountedNameLookup
 
-termRefsForExactName :: PG.QueryM m => NamesPerspective -> ReversedName -> m [NamedRef V1.Referent]
+termRefsForExactName :: (PG.QueryM m) => NamesPerspective -> ReversedName -> m [NamedRef V1.Referent]
 termRefsForExactName namesPerspective reversedName = do
   refsForExactName NameLookupQ.termRefsForExactName namesPerspective reversedName
     >>= traverse (traverse (CV.referentPGTo1UsingCT))
 
-typeRefsForExactName :: PG.QueryM m => NamesPerspective -> ReversedName -> m [NamedRef V1.Reference]
+typeRefsForExactName :: (PG.QueryM m) => NamesPerspective -> ReversedName -> m [NamedRef V1.Reference]
 typeRefsForExactName namesPerspective reversedName = do
   refsForExactName NameLookupQ.typeRefsForExactName namesPerspective reversedName
     >>= (traverse . traverse) CV.referencePGTo1
 
 -- | Check whether we've already got an index for a given branch hash.
-checkBranchHashNameLookupExists :: PG.QueryM m => BranchHash -> m Bool
+checkBranchHashNameLookupExists :: (PG.QueryM m) => BranchHash -> m Bool
 checkBranchHashNameLookupExists bh = do
   bhId <- HashQ.ensureBranchHashId bh
   Q.checkBranchHashNameLookupExists bhId
@@ -180,7 +181,7 @@ deleteNameLookupsExceptFor reachable = do
   bhIds <- for (Set.toList reachable) HashQ.ensureBranchHashId
   Q.deleteNameLookupsExceptFor bhIds
 
-ensureNameLookupForBranchId :: QueryM m => BranchHashId -> m NameLookupReceipt
+ensureNameLookupForBranchId :: (QueryM m) => BranchHashId -> m NameLookupReceipt
 ensureNameLookupForBranchId branchHashId = do
   PG.execute_ [PG.sql| SELECT ensure_name_lookup(#{branchHashId}) |]
   pure $ UnsafeNameLookupReceipt

src/Share/Postgres/NameLookups/Types.hs

@@ -34,7 +34,7 @@ import Share.Prelude
 import U.Codebase.Referent (ConstructorType)
 import Unison.Name (Name)
 import Unison.Name qualified as Name
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment.Internal (NameSegment (..))
 
 -- | Proof that we've checked that a given name lookup exists before we try to use it.
 data NameLookupReceipt = UnsafeNameLookupReceipt
@@ -75,7 +75,7 @@ newtype ReversedName = ReversedName (NonEmpty Text)
 
 reversedNameToName :: ReversedName -> Name
 reversedNameToName (ReversedName revName) =
-  Name.fromReverseSegments (coerce @(NonEmpty Text) @(NonEmpty NameSegment) revName)
+  Name.fromReverseSegments (NameSegment <$> revName)
 
 instance From ReversedName Name where
   from = reversedNameToName
@@ -158,7 +158,7 @@ data NamedRef ref = NamedRef {reversedSegments :: ReversedName, ref :: ref}
 ref_ :: Lens (NamedRef ref) (NamedRef ref') ref ref'
 ref_ = lens ref (\namedRef ref -> namedRef {ref = ref})
 
-instance PG.DecodeRow ref => PG.DecodeRow (NamedRef ref) where
+instance (PG.DecodeRow ref) => PG.DecodeRow (NamedRef ref) where
   decodeRow = do
     reversedSegments <- PG.decodeField
     ref <- PG.decodeRow

src/Share/Postgres/Orphans.hs

@@ -10,15 +10,15 @@ import Data.Bytes.Put (runPutS)
 import Data.Either.Extra qualified as Either
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
-import Share.Prelude
-import Share.Utils.Logging qualified as Logging
-import Share.Web.Errors (ErrorID (..), ToServerError (..))
 import Hasql.Decoders qualified as Decoders
 import Hasql.Encoders qualified as Encoders
 import Hasql.Interpolate qualified as Hasql
 import Hasql.Session qualified as Hasql
 import Servant (err500)
 import Servant.API
+import Share.Prelude
+import Share.Utils.Logging qualified as Logging
+import Share.Web.Errors (ErrorID (..), ToServerError (..))
 import U.Codebase.HashTags (BranchHash (..), CausalHash (..), ComponentHash (..), PatchHash (..))
 import U.Codebase.Reference (Id' (Id), Reference' (..))
 import U.Codebase.Referent (ConstructorType (..), Referent' (..))
@@ -32,7 +32,7 @@ import Unison.Hash (Hash)
 import Unison.Hash qualified as Hash
 import Unison.Hash32 (Hash32)
 import Unison.Hash32 qualified as Hash32
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment.Internal (NameSegment (..))
 
 -- Orphans for 'Hash'
 instance Hasql.EncodeValue Hash where
@@ -57,7 +57,8 @@ instance Hasql.DecodeValue Hash32 where
     Hasql.decodeValue
       -- We can trust that encoded values are valid,
       -- and skipping validation is a significant performance improvement
-      <&> Hash32.unsafeFromBase32Hex . Base32Hex.UnsafeFromText
+      <&> Hash32.unsafeFromBase32Hex
+      . Base32Hex.UnsafeFromText
 
 instance FromHttpApiData Hash where
   parseUrlPiece txt =
@@ -140,7 +141,7 @@ instance Hasql.EncodeValue ConstructorType where
         EffectConstructor -> 1
 
 -- | Decode a single field as part of a Row
-decodeField :: Hasql.DecodeField a => Decoders.Row a
+decodeField :: (Hasql.DecodeField a) => Decoders.Row a
 decodeField = Decoders.column Hasql.decodeField
 
 instance Hasql.EncodeValue TempEntity where

src/Share/Postgres/Sync/Conversions.hs

@@ -16,7 +16,8 @@ import U.Codebase.Sqlite.Patch.TypeEdit qualified as PatchFullTypeEdit
 import U.Codebase.TermEdit qualified as V2TermEdit
 import U.Codebase.TypeEdit qualified as V2TypeEdit
 import Unison.Hash (Hash)
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment (NameSegment)
+import Unison.NameSegment.Internal qualified as NameSegment
 import Unison.Util.Map qualified as Map
 
 branchV2ToBF ::
@@ -53,7 +54,7 @@ branchV2ToBF (V2.Branch {terms, types, patches, children}) = do
     convertChildren :: Map NameSegment (V2.CausalBranch m) -> Map Text (Hash, Hash)
     convertChildren =
       Map.bimap
-        (coerce @NameSegment @Text)
+        NameSegment.toUnescapedText
         ((unBranchHash . Causal.valueHash) &&& (unCausalHash . Causal.causalHash))
 
 patchV2ToPF :: V2.Patch -> PatchFull.Patch' Text Hash Hash

src/Share/Web/Authorization.hs

@@ -94,7 +94,7 @@ import Share.Web.Share.Tickets.Types
 import Servant
 import Unison.Codebase.Path (Path)
 import Unison.Codebase.Path qualified as Path
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment.Internal (NameSegment (..))
 
 -- | Proof that an auth check has been run at some point.
 data AuthZReceipt = AuthZReceipt {getCacheability :: Maybe CachingToken}
@@ -271,7 +271,7 @@ writePath :: Path -> CodebasePermission
 writePath path = UserCodebaseWritePath (Path.toList path)
 
 isPublicPath :: [NameSegment] -> Bool
-isPublicPath ("public" : _) = True
+isPublicPath (NameSegment "public" : _) = True
 isPublicPath _ = False
 
 -- | Requests should only be cached if they're for a public endpoint.

src/Share/Web/Share/Branches/Impl.hs

@@ -11,6 +11,7 @@ import Data.List.NonEmpty qualified as NonEmpty
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Time (UTCTime)
+import Servant
 import Share.Branch (Branch (..), branchCausals_)
 import Share.Codebase qualified as Codebase
 import Share.IDs (BranchId, BranchShortHand (..), ProjectBranchShortHand (..), ProjectShortHand (..), ProjectSlug (..), UserHandle, UserId)
@@ -38,12 +39,11 @@ import Share.Web.Share.Branches.Types qualified as API
 import Share.Web.Share.CodeBrowsing.API qualified as API
 import Share.Web.Share.Projects.Types (projectToAPI)
 import Share.Web.Share.Types
-import Servant
 import U.Codebase.HashTags (CausalHash)
 import Unison.Codebase.Path qualified as Path
 import Unison.HashQualified qualified as HQ
 import Unison.Name (Name)
-import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment.Internal (NameSegment (..))
 import Unison.Reference (Reference)
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent

src/Share/Web/Share/Releases/Impl.hs

@@ -14,6 +14,7 @@ import Control.Monad.Except
 import Control.Monad.Trans.Maybe
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Set qualified as Set
+import Servant
 import Share.Codebase qualified as Codebase
 import Share.IDs
 import Share.IDs qualified as IDs
@@ -42,11 +43,10 @@ import Share.Web.Share.Releases.Types
 import Share.Web.Share.Releases.Types qualified as API
 import Share.Web.Share.Types
 import Share.Web.UCM.Sync.Impl qualified as SyncQ
-import Servant
 import Unison.Codebase.Path qualified as Path
 import Unison.HashQualified qualified as HQ
 import Unison.Name (Name)
-import Unison.NameSegment (NameSegment (NameSegment))
+import Unison.NameSegment.Internal (NameSegment (..))
 import Unison.Reference (Reference)
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent