module U.Codebase.Projects
  ( inferDependencyMounts,
  )
where

import Control.Lens (ifoldMap)
import Data.Map qualified as Map
import U.Codebase.Branch
import U.Codebase.Branch qualified as Branch
import U.Codebase.Causal qualified as Causal
import U.Codebase.HashTags (BranchHash (..))
import Unison.Codebase.Path
import Unison.Codebase.Path qualified as Path
import Unison.NameSegment (libSegment)
import Unison.Prelude
import Unison.Sqlite qualified as Sqlite
import Unison.Util.Monoid (ifoldMapM)

-- | Find all dependency mounts within a branch and the path to those mounts.
--
-- For a typical project this will return something like:
-- @[(lib.base, #abc), (lib.distributed, #def)]@
--
-- For the top-level name lookup of a user codebase it returns the project roots, and will return something like:
-- @[(public.nested.myproject.latest, #abc), (public.other.namespace.otherproject.main, #def)]@
inferDependencyMounts :: Branch Sqlite.Transaction -> Sqlite.Transaction [(Path, BranchHash)]
inferDependencyMounts :: Branch Transaction -> Transaction [(Path, BranchHash)]
inferDependencyMounts Branch Transaction
branch = do
  Map NameSegment (CausalBranch Transaction)
children <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
Branch.nonEmptyChildren Branch Transaction
branch
  do
    Map NameSegment (CausalBranch Transaction)
children
    Map NameSegment (CausalBranch Transaction)
-> (Map NameSegment (CausalBranch Transaction)
    -> Transaction [(Path, BranchHash)])
-> Transaction [(Path, BranchHash)]
forall a b. a -> (a -> b) -> b
& (NameSegment
 -> CausalBranch Transaction -> Transaction [(Path, BranchHash)])
-> Map NameSegment (CausalBranch Transaction)
-> Transaction [(Path, BranchHash)]
forall r (f :: * -> *) (t :: * -> *) i a.
(Monoid r, Applicative f, Foldable t, TraversableWithIndex i t) =>
(i -> a -> f r) -> t a -> f r
ifoldMapM \NameSegment
segment CausalBranch Transaction
child -> do
      case NameSegment
segment of
        NameSegment
seg
          | NameSegment
seg NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
libSegment -> do
              Branch Transaction
childBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
Causal.value CausalBranch Transaction
child
              Map NameSegment (CausalBranch Transaction)
deps <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
Branch.nonEmptyChildren Branch Transaction
childBranch
              Map NameSegment (CausalBranch Transaction)
deps
                Map NameSegment (CausalBranch Transaction)
-> (Map NameSegment (CausalBranch Transaction)
    -> [(Path, BranchHash)])
-> [(Path, BranchHash)]
forall a b. a -> (a -> b) -> b
& ( (NameSegment -> CausalBranch Transaction -> [(Path, BranchHash)])
-> Map NameSegment (CausalBranch Transaction)
-> [(Path, BranchHash)]
forall m a.
Monoid m =>
(NameSegment -> a -> m) -> Map NameSegment a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap \NameSegment
depName CausalBranch Transaction
depBranch ->
                      [([NameSegment] -> Path
Path.fromList [NameSegment
seg, NameSegment
depName], CausalBranch Transaction -> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
Causal.valueHash CausalBranch Transaction
depBranch)]
                  )
                [(Path, BranchHash)]
-> ([(Path, BranchHash)] -> Transaction [(Path, BranchHash)])
-> Transaction [(Path, BranchHash)]
forall a b. a -> (a -> b) -> b
& [(Path, BranchHash)] -> Transaction [(Path, BranchHash)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          | Bool
otherwise -> do
              Branch Transaction
childBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
Causal.value CausalBranch Transaction
child
              Map NameSegment (CausalBranch Transaction)
nestedChildren <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
Branch.nonEmptyChildren Branch Transaction
childBranch
              -- If a given child has a lib child, then it's inferred to be a project root.
              -- This allows us to detect most project roots in loose code.
              -- Note, we only do this on children nested at least one level deep
              -- to avoid treating project roots as their own self-referential dependency
              -- mounts. Mount paths must not be empty.
              case NameSegment -> Map NameSegment (CausalBranch Transaction) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member NameSegment
libSegment Map NameSegment (CausalBranch Transaction)
nestedChildren of
                Bool
True -> [(Path, BranchHash)] -> Transaction [(Path, BranchHash)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [([NameSegment] -> Path
Path.fromList [NameSegment
seg], CausalBranch Transaction -> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
Causal.valueHash CausalBranch Transaction
child)]
                Bool
False -> Branch Transaction -> Transaction [(Path, BranchHash)]
inferDependencyMounts Branch Transaction
childBranch Transaction [(Path, BranchHash)]
-> ([(Path, BranchHash)] -> [(Path, BranchHash)])
-> Transaction [(Path, BranchHash)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Path, BranchHash) -> (Path, BranchHash))
-> [(Path, BranchHash)] -> [(Path, BranchHash)]
forall a b. (a -> b) -> [a] -> [b]
map ((Path -> Path) -> (Path, BranchHash) -> (Path, BranchHash)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (NameSegment -> Path -> Path
Path.cons NameSegment
seg))