implement Actions2.searchBranch'

.gitignore

@@ -23,6 +23,7 @@ target
 htags
 scala-tags
 haskell-tags
+out
 
 # Stack
 .stack-work

parser-typechecker/src/Unison/Codebase/Branch2.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Unison.Codebase.Branch2 where
 
@@ -14,12 +15,16 @@ module Unison.Codebase.Branch2 where
 import           Prelude                  hiding (head,read,subtract)
 
 import           Control.Lens            hiding ( children )
+import qualified Control.Monad                 as Monad
 --import           Control.Monad.Extra            ( whenM )
 -- import           Data.GUID                (genText)
 --import           Data.List                      ( intercalate )
 import qualified Data.Map                      as Map
 import           Data.Map                       ( Map )
+import qualified Data.Set                      as Set
+import           Data.Set                       ( Set )
 import           Data.Text                      ( Text )
+import           Data.Tuple                     (swap)
 --import qualified Data.Text                     as Text
 import           Data.Foldable                  ( for_ )
 import qualified Unison.Codebase.Causal2       as Causal
@@ -28,6 +33,8 @@ import           Unison.Codebase.Causal2        ( Causal
                                                 , pattern RawCons
                                                 , pattern RawMerge
                                                 )
+import           Unison.Codebase.SearchResult (SearchResult)
+import qualified Unison.Codebase.SearchResult as SR
 import           Unison.Codebase.TermEdit       ( TermEdit )
 import           Unison.Codebase.TypeEdit       ( TypeEdit )
 import           Unison.Codebase.Path           ( NameSegment
@@ -37,17 +44,30 @@ import qualified Unison.Codebase.Path          as Path
 --import           Unison.Hash                    ( Hash )
 import           Unison.Hashable                ( Hashable )
 import qualified Unison.Hashable               as H
+import qualified Unison.HashQualified          as HQ
+
 import           Unison.Name                    ( Name )
+import           Unison.Names2                  ( Names0 )
 import           Unison.Reference               ( Reference )
-import           Unison.Referent                ( Referent )
+import           Unison.Referent                ( Referent(Con,Ref) )
 import qualified Unison.Util.Relation          as R
 import           Unison.Util.Relation           ( Relation )
+import qualified Unison.Util.List              as List
+
 
 -- type EditGuid = Text
 
 newtype Branch m = Branch { _history :: Causal m Raw (Branch0 m) }
   deriving (Eq, Ord)
 
+data BranchEntry = TermEntry Referent | TypeEntry Reference deriving (Eq,Ord,Show)
+
+branchEntryReference :: BranchEntry -> Reference
+branchEntryReference = \case
+  TermEntry (Con r _i) -> r
+  TermEntry (Ref r) -> r
+  TypeEntry r -> r
+
 head :: Branch m -> Branch0 m
 head (Branch c) = Causal.head c
 
@@ -59,6 +79,7 @@ type Hash = Causal.RawHash Raw
 data Branch0 m = Branch0
   { _terms :: Relation NameSegment Referent
   , _types :: Relation NameSegment Reference
+--  , _edits :: Relation NameSegment Edits
   -- Q: How will we handle merges and conflicts for `children`?
   --    Should this be a relation?
   --    What is the UX to resolve conflicts?
@@ -91,6 +112,24 @@ instance Eq (Branch0 m) where
 
 data ForkFailure = SrcNotFound | DestExists
 
+fold :: Monad m => (a -> Name -> BranchEntry -> a) -> a -> Branch m -> m a
+fold f = foldM (\a n b -> pure (f a n b))
+
+foldM :: forall m a. Monad m
+      => (a -> Name -> BranchEntry -> m a) -> a -> Branch m -> m a
+foldM f a (head -> b) = go Path.empty b a where
+  doTerm p a (seg, r) = f a (Path.toName (p `Path.snoc` seg)) (TermEntry r)
+  doType p a (seg, r) = f a (Path.toName (p `Path.snoc` seg)) (TypeEntry r)
+  doChild p a (seg, (_hash, head -> b)) = go (p `Path.snoc` seg) b a
+  go :: Path -> Branch0 m -> a -> m a
+  go p b a = do
+    a1 <- Monad.foldM (doTerm p) a (R.toList . view terms $ b)
+    a2 <- Monad.foldM (doType p) a1 (R.toList . view types $ b)
+    Monad.foldM (doChild p) a2 (Map.toList . view children $ b)
+
+allEntries :: Monad m => Branch m -> m [(Name, BranchEntry)]
+allEntries = fmap reverse . fold (\l n e -> (n, e) : l) []
+
 -- Question: How does Deserialize throw a not-found error?
 -- Question: What is the previous question?
 read

parser-typechecker/src/Unison/Codebase/Editor/Actions2.hs

@@ -42,7 +42,7 @@ import           Data.Set                       ( Set )
 import qualified Unison.ABT                    as ABT
 import           Unison.Codebase.Branch2        ( Branch
                                                 , Branch0
-                                                , Edits
+                                                , Edits, BranchEntry
                                                 )
 import qualified Unison.Codebase.Branch2       as Branch
 import           Unison.Codebase.Editor2        ( Command(..)
@@ -84,6 +84,8 @@ import qualified Unison.Util.Find              as Find
 import           Unison.Util.Free               ( Free )
 import qualified Unison.Util.Free              as Free
 import qualified Unison.Util.Relation          as Relation
+import qualified Unison.Util.Relation          as R
+import           Unison.Util.Relation           ( Relation )
 import           Unison.Var                     ( Var )
 
 type F m i v = Free (Command m i v)
@@ -414,18 +416,37 @@ searchBranch (Branch.head -> b) queries = \case
       [] -> Nothing
       (m, _) : _ -> Just m
 
-collectHashQualified :: Monad m => Branch m -> m (Set HashQualified)
-collectHashQualified (Branch.head -> b) = search mempty b where
-  search :: Path -> Branch0 m -> m (Set HashQualified)
-  search path b = error "todo"
-
-
 searchBranch' :: forall m score. (Ord score)
               => Branch0 m
               -> (Name -> Name -> Maybe score)
               -> [HashQualified]
               -> m [SearchResult]
 searchBranch' = error "todo"
+  where
+  wrangle :: [(Name, BranchEntry)] -> [SearchResult]
+  wrangle entries = go <$> entries where
+    go (n, e) = case e of
+      Branch.TypeEntry r ->
+        SR.typeResult (hq e n) r (Set.map (hq e) (Relation.lookupRan e typeR))
+      Branch.TermEntry r ->
+        SR.termResult (hq e n) r (Set.map (hq e) (Relation.lookupRan e termR))
+    -- basically splitting the names up into separate type/term namespaces,
+    -- so we can tell if the names are conflicted and need to be hash-qualified
+    typeR, termR :: Relation Name BranchEntry
+    typeR = Relation.fromList [ (n,e) | (n, e@Branch.TypeEntry{}) <- entries ]
+    termR = Relation.fromList [ (n,e) | (n, e@Branch.TermEntry{}) <- entries ]
+    isQualifiedType, isQualifiedTerm :: Name -> Bool
+    isQualifiedType n = Relation.manyDom n typeR
+    isQualifiedTerm n = Relation.manyDom n termR
+    hq :: BranchEntry -> Name -> HQ.HashQualified
+    hq e n = case e of
+      Branch.TypeEntry r -> if isQualifiedType n
+        then HQ.take 3 $ HQ.fromNamedReference n r else HQ.fromName n
+      Branch.TermEntry r -> if isQualifiedTerm n
+        then HQ.take 3 $ HQ.fromNamedReferent n r else HQ.fromName n
+    hashLength = 3
+
+
 
 
 -- withBranch :: BranchName -> (Branch -> Action m i v ()) -> Action m i v ()

parser-typechecker/src/Unison/Codebase/Path.hs

@@ -53,6 +53,9 @@ asDirectory p = case toList p of
 fromName :: Name -> Path
 fromName = fromList . fmap NameSegment . Text.splitOn "." . Name.toText
 
+toName :: Path -> Name
+toName = Name.unsafeFromText . asIdentifier
+
 -- Returns the nearest common ancestor, along with the
 -- two inputs relativized to that ancestor.
 relativeToAncestor :: Path -> Path -> (Path, Path, Path)

parser-typechecker/src/Unison/Util/List.hs

@@ -12,8 +12,9 @@ multimap kvs =
   where
   step m (k,v) = Map.insertWith (++) k [v] m
 
--- prefers earlier copies
-uniqueBy :: (Foldable f, Ord b) => (a -> b) -> f a -> [a]
+-- returns the subset of `f a` which maps to unique `b`s.
+-- prefers earlier copies, if many `a` map to some `b`.
+uniqueBy, nubOrdBy :: (Foldable f, Ord b) => (a -> b) -> f a -> [a]
 uniqueBy f as = wrangle' (toList as) Set.empty where
   wrangle' [] _ = []
   wrangle' (a:as) seen =
@@ -21,6 +22,7 @@ uniqueBy f as = wrangle' (toList as) Set.empty where
     then wrangle' as seen
     else a : wrangle' as (Set.insert b seen)
     where b = f a
+nubOrdBy = uniqueBy
 
 -- prefers later copies
 uniqueBy' :: (Foldable f, Ord b) => (a -> b) -> f a -> [a]

parser-typechecker/src/Unison/Util/Relation.hs

@@ -26,7 +26,7 @@ import qualified Data.Map                      as Map
 --
 -- 3. If you subtract, take care when handling the set of values.
 --
--- As a multi-map, each key is asscoated with a Set of values v.
+-- As a multi-map, each key is associated with a Set of values v.
 --
 -- We do not allow the associations with the 'empty' Set.
 --
@@ -200,7 +200,12 @@ member x y r = case lookupDom' x r of
 notMember :: (Ord a, Ord b) => a -> b -> Relation a b -> Bool
 notMember x y r = not $ member x y r
 
+-- | True if a value appears more than one time in the relation.
+manyDom :: Ord a => a -> Relation a b -> Bool
+manyDom a = (>1) . S.size . lookupDom a
 
+manyRan :: Ord b => b -> Relation a b -> Bool
+manyRan b = (>1) . S.size . lookupRan b
 
 -- | Returns the domain in the relation, as a Set, in its entirety.
 dom :: Relation a b -> Set a