module U.Codebase.Projects
  ( inferDependencyMounts,
  )
where

import Control.Lens (ifoldMap)
import Data.Bool (bool)
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 =
  (NameSegment
 -> Causal
      Transaction
      CausalHash
      BranchHash
      (Branch Transaction)
      (Branch Transaction)
 -> Transaction [(Path, BranchHash)])
-> Map
     NameSegment
     (Causal
        Transaction
        CausalHash
        BranchHash
        (Branch Transaction)
        (Branch 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
seg Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
child -> do
        Branch Transaction
childBranch <- Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
-> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
Causal.value Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
child
        if NameSegment
seg NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
libSegment
          then
            (NameSegment
 -> Causal
      Transaction
      CausalHash
      BranchHash
      (Branch Transaction)
      (Branch Transaction)
 -> [(Path, BranchHash)])
-> Map
     NameSegment
     (Causal
        Transaction
        CausalHash
        BranchHash
        (Branch Transaction)
        (Branch 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 Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
depBranch -> [([NameSegment] -> Path
Path.fromList [NameSegment
seg, NameSegment
depName], Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
-> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
Causal.valueHash Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
depBranch)])
              (Map
   NameSegment
   (Causal
      Transaction
      CausalHash
      BranchHash
      (Branch Transaction)
      (Branch Transaction))
 -> [(Path, BranchHash)])
-> Transaction
     (Map
        NameSegment
        (Causal
           Transaction
           CausalHash
           BranchHash
           (Branch Transaction)
           (Branch Transaction)))
-> Transaction [(Path, BranchHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch Transaction
-> Transaction
     (Map
        NameSegment
        (Causal
           Transaction
           CausalHash
           BranchHash
           (Branch Transaction)
           (Branch Transaction)))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
Branch.nonEmptyChildren Branch Transaction
childBranch
          else -- 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.

            Transaction [(Path, BranchHash)]
-> Transaction [(Path, BranchHash)]
-> Bool
-> Transaction [(Path, BranchHash)]
forall a. a -> a -> Bool -> a
bool
              (((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 ((Path -> Path) -> (Path, BranchHash) -> (Path, BranchHash))
-> (Path -> Path -> Path)
-> Path
-> (Path, BranchHash)
-> (Path, BranchHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Path -> Path
forall l r o. Resolve l r o => l -> r -> o
Path.resolve (Path -> (Path, BranchHash) -> (Path, BranchHash))
-> Path -> (Path, BranchHash) -> (Path, BranchHash)
forall a b. (a -> b) -> a -> b
$ NameSegment -> Path
Path.singleton NameSegment
seg) ([(Path, BranchHash)] -> [(Path, BranchHash)])
-> Transaction [(Path, BranchHash)]
-> Transaction [(Path, BranchHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch Transaction -> Transaction [(Path, BranchHash)]
inferDependencyMounts Branch Transaction
childBranch)
              ([(Path, BranchHash)] -> Transaction [(Path, BranchHash)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(NameSegment -> Path
Path.singleton NameSegment
seg, Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
-> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
Causal.valueHash Causal
  Transaction
  CausalHash
  BranchHash
  (Branch Transaction)
  (Branch Transaction)
child)])
              (Bool -> Transaction [(Path, BranchHash)])
-> (Map
      NameSegment
      (Causal
         Transaction
         CausalHash
         BranchHash
         (Branch Transaction)
         (Branch Transaction))
    -> Bool)
-> Map
     NameSegment
     (Causal
        Transaction
        CausalHash
        BranchHash
        (Branch Transaction)
        (Branch Transaction))
-> Transaction [(Path, BranchHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment
-> Map
     NameSegment
     (Causal
        Transaction
        CausalHash
        BranchHash
        (Branch Transaction)
        (Branch Transaction))
-> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member NameSegment
libSegment
              (Map
   NameSegment
   (Causal
      Transaction
      CausalHash
      BranchHash
      (Branch Transaction)
      (Branch Transaction))
 -> Transaction [(Path, BranchHash)])
-> Transaction
     (Map
        NameSegment
        (Causal
           Transaction
           CausalHash
           BranchHash
           (Branch Transaction)
           (Branch Transaction)))
-> Transaction [(Path, BranchHash)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Branch Transaction
-> Transaction
     (Map
        NameSegment
        (Causal
           Transaction
           CausalHash
           BranchHash
           (Branch Transaction)
           (Branch Transaction)))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
Branch.nonEmptyChildren Branch Transaction
childBranch
    )
    (Map
   NameSegment
   (Causal
      Transaction
      CausalHash
      BranchHash
      (Branch Transaction)
      (Branch Transaction))
 -> Transaction [(Path, BranchHash)])
-> (Branch Transaction
    -> Transaction
         (Map
            NameSegment
            (Causal
               Transaction
               CausalHash
               BranchHash
               (Branch Transaction)
               (Branch Transaction))))
-> Branch Transaction
-> Transaction [(Path, BranchHash)]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Branch Transaction
-> Transaction
     (Map
        NameSegment
        (Causal
           Transaction
           CausalHash
           BranchHash
           (Branch Transaction)
           (Branch Transaction)))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
Branch.nonEmptyChildren