<commit_before>{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Codebase.Conversion.Sync12 where

import Control.Lens
import qualified Control.Lens as Lens
import Control.Monad.Except (MonadError, runExceptT)
import qualified Control.Monad.Except as Except
import Control.Monad.Extra ((&&^))
import Control.Monad.Reader
import qualified Control.Monad.Reader as Reader
import Control.Monad.State (MonadState)
import qualified Control.Monad.State as State
import Control.Monad.Validate (MonadValidate, runValidateT)
import qualified Control.Monad.Validate as Validate
import Control.Natural (type (~>))
import Data.Bifoldable (bitraverse_)
import Data.Foldable (traverse_)
import qualified Data.Foldable as Foldable
import Data.Functor (($>))
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import qualified Data.Set as Set
import Data.Traversable (for)
import Database.SQLite.Simple (Connection)
import Debug.Trace (traceM)
import U.Codebase.Sqlite.DbId (Generation)
import qualified U.Codebase.Sqlite.Queries as Q
import U.Codebase.Sync (Sync (Sync), TrySyncResult)
import qualified U.Codebase.Sync as Sync
import qualified U.Util.Monoid as Monoid
import Unison.Codebase (Codebase)
import qualified Unison.Codebase as Codebase
import Unison.Codebase.Branch (UnwrappedBranch)
import qualified Unison.Codebase.Branch as Branch
import qualified Unison.Codebase.Causal as Causal
import qualified Unison.Codebase.Metadata as Metadata
import Unison.Codebase.Patch (Patch (..))
import qualified Unison.Codebase.TermEdit as TermEdit
import qualified Unison.Codebase.TypeEdit as TypeEdit
import Unison.DataDeclaration (Decl)
import qualified Unison.DataDeclaration as DD
import Unison.Hash (Hash)
import qualified Unison.Hashable as H
import qualified Unison.LabeledDependency as LD
import Unison.NameSegment (NameSegment)
import Unison.Prelude (Set)
import qualified Unison.Reference as Reference
import Unison.Referent (Referent)
import qualified Unison.Referent as Referent
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import qualified Unison.Term as Term
import Unison.Type (Type)
import qualified Unison.Type as Type
import Unison.Util.Relation (Relation)
import qualified Unison.Util.Relation as Relation
import Unison.Util.Star3 (Star3 (Star3))
import System.IO (stdout)
import System.IO.Extra (hFlush)

debug :: Bool
debug = False

data Env m a = Env
  { srcCodebase :: Codebase m Symbol a,
    destCodebase :: Codebase m Symbol a,
    destConnection :: Connection
  }

data Entity m
  = C Branch.Hash (m (UnwrappedBranch m))
  | T Hash Reference.Size
  | D Hash Reference.Size
  | P Branch.EditHash

type V m n = MonadValidate (Set (Entity m)) n

type E e n = MonadError e n

type S m n = MonadState (Status m) n

type R m n a = MonadReader (Env m a) n

type RS m n a = (R m n a, S m n)

data BranchStatus m
  = BranchOk
  | BranchReplaced Branch.Hash (UnwrappedBranch m)

data TermStatus
  = TermOk
  | TermMissing
  | TermMissingType
  | TermMissingDependencies
  deriving Show

data DeclStatus
  = DeclOk
  | DeclMissing
  | DeclMissingDependencies
  deriving Show

data PatchStatus
  = PatchOk
  | PatchMissing
  | PatchReplaced Branch.EditHash
  deriving Show

data Status m = Status
  { _branchStatus :: Map Branch.Hash (BranchStatus m),
    _termStatus :: Map Hash TermStatus,
    _declStatus :: Map Hash DeclStatus,
    _patchStatus :: Map Branch.EditHash PatchStatus
  }

emptyStatus :: Status m
emptyStatus = Status mempty mempty mempty mempty

makeLenses ''Status

sync12 ::
  (MonadIO f, MonadReader (Env p x) f, RS m n a, Applicative m) =>
  (m ~> n) ->
  f (Sync n (Entity m))
sync12 t = do
  gc <- runDest' Q.getNurseryGeneration
  pure $ Sync (trySync t (succ gc))

trySync ::
  forall m n a.
  (R m n a, S m n, Applicative m) =>
  (m ~> n) ->
  Generation ->
  Entity m ->
  n (TrySyncResult (Entity m))
trySync t _gc e = do
  Env _ dest _ <- Reader.ask
  case e of
    C h mc -> do
      -- getBranchStatus h >>= \case
      --   Just {} -> pure Sync.PreviouslyDone
      --   Nothing -> t (Codebase.branchExists dest h) >>= \case
      --     True -> setBranchStatus h BranchOk $> Sync.PreviouslyDone
      --     False -> do
      --       c <- t mc
      --       runValidateT @_ @n (repairBranch c) >>= \case
      --         Left deps -> pure . Sync.Missing $ Foldable.toList deps
      --         Right c' -> do
      --           let h' = Causal.currentHash c'
      --           t $ Codebase.putBranch dest (Branch.Branch c')
      --           if h == h'
      --             then do
      --               setBranchStatus @m @n h BranchOk
      --               pure Sync.Done
      --             else do
      --               setBranchStatus h (BranchReplaced h' c')
      --               pure Sync.NonFatalError



      t (Codebase.branchExists dest h) >>= \case
        True -> setBranchStatus h BranchOk $> Sync.PreviouslyDone
        False -> do
          c <- t mc
          runValidateT @_ @n (repairBranch c) >>= \case
            Left deps -> pure . Sync.Missing $ Foldable.toList deps
            Right c' -> do
              let h' = Causal.currentHash c'
              t $ Codebase.putBranch dest (Branch.Branch c')
              if h == h'
                then do
                  setBranchStatus @m @n h BranchOk
                  pure Sync.Done
                else do
                  setBranchStatus h (BranchReplaced h' c')
                  pure Sync.NonFatalError

    T h n ->
      getTermStatus h >>= \case
        Just {} -> pure Sync.PreviouslyDone
        Nothing -> do
          runExceptT (runValidateT (checkTermComponent (lift . lift . t) h n)) >>= \case
            Left status -> do
              setTermStatus h status
              pure Sync.NonFatalError
            Right (Left deps) ->
              pure . Sync.Missing $ Foldable.toList deps
            Right (Right component) -> do
              Foldable.for_ (zip component [0 ..]) \((term, typ), i) ->
                t $ Codebase.putTerm dest (Reference.Id h i n) term typ<commit_msg>let Sync12 getBranchStatus before branchExists<commit_after>{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Codebase.Conversion.Sync12 where

import Control.Lens
import qualified Control.Lens as Lens
import Control.Monad.Except (MonadError, runExceptT)
import qualified Control.Monad.Except as Except
import Control.Monad.Extra ((&&^))
import Control.Monad.Reader
import qualified Control.Monad.Reader as Reader
import Control.Monad.State (MonadState)
import qualified Control.Monad.State as State
import Control.Monad.Validate (MonadValidate, runValidateT)
import qualified Control.Monad.Validate as Validate
import Control.Natural (type (~>))
import Data.Bifoldable (bitraverse_)
import Data.Foldable (traverse_)
import qualified Data.Foldable as Foldable
import Data.Functor (($>))
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import qualified Data.Set as Set
import Data.Traversable (for)
import Database.SQLite.Simple (Connection)
import Debug.Trace (traceM)
import U.Codebase.Sqlite.DbId (Generation)
import qualified U.Codebase.Sqlite.Queries as Q
import U.Codebase.Sync (Sync (Sync), TrySyncResult)
import qualified U.Codebase.Sync as Sync
import qualified U.Util.Monoid as Monoid
import Unison.Codebase (Codebase)
import qualified Unison.Codebase as Codebase
import Unison.Codebase.Branch (UnwrappedBranch)
import qualified Unison.Codebase.Branch as Branch
import qualified Unison.Codebase.Causal as Causal
import qualified Unison.Codebase.Metadata as Metadata
import Unison.Codebase.Patch (Patch (..))
import qualified Unison.Codebase.TermEdit as TermEdit
import qualified Unison.Codebase.TypeEdit as TypeEdit
import Unison.DataDeclaration (Decl)
import qualified Unison.DataDeclaration as DD
import Unison.Hash (Hash)
import qualified Unison.Hashable as H
import qualified Unison.LabeledDependency as LD
import Unison.NameSegment (NameSegment)
import Unison.Prelude (Set)
import qualified Unison.Reference as Reference
import Unison.Referent (Referent)
import qualified Unison.Referent as Referent
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import qualified Unison.Term as Term
import Unison.Type (Type)
import qualified Unison.Type as Type
import Unison.Util.Relation (Relation)
import qualified Unison.Util.Relation as Relation
import Unison.Util.Star3 (Star3 (Star3))
import System.IO (stdout)
import System.IO.Extra (hFlush)

debug :: Bool
debug = False

data Env m a = Env
  { srcCodebase :: Codebase m Symbol a,
    destCodebase :: Codebase m Symbol a,
    destConnection :: Connection
  }

data Entity m
  = C Branch.Hash (m (UnwrappedBranch m))
  | T Hash Reference.Size
  | D Hash Reference.Size
  | P Branch.EditHash

type V m n = MonadValidate (Set (Entity m)) n

type E e n = MonadError e n

type S m n = MonadState (Status m) n

type R m n a = MonadReader (Env m a) n

type RS m n a = (R m n a, S m n)

data BranchStatus m
  = BranchOk
  | BranchReplaced Branch.Hash (UnwrappedBranch m)

data TermStatus
  = TermOk
  | TermMissing
  | TermMissingType
  | TermMissingDependencies
  deriving Show

data DeclStatus
  = DeclOk
  | DeclMissing
  | DeclMissingDependencies
  deriving Show

data PatchStatus
  = PatchOk
  | PatchMissing
  | PatchReplaced Branch.EditHash
  deriving Show

data Status m = Status
  { _branchStatus :: Map Branch.Hash (BranchStatus m),
    _termStatus :: Map Hash TermStatus,
    _declStatus :: Map Hash DeclStatus,
    _patchStatus :: Map Branch.EditHash PatchStatus
  }

emptyStatus :: Status m
emptyStatus = Status mempty mempty mempty mempty

makeLenses ''Status

sync12 ::
  (MonadIO f, MonadReader (Env p x) f, RS m n a, Applicative m) =>
  (m ~> n) ->
  f (Sync n (Entity m))
sync12 t = do
  gc <- runDest' Q.getNurseryGeneration
  pure $ Sync (trySync t (succ gc))

trySync ::
  forall m n a.
  (R m n a, S m n, Applicative m) =>
  (m ~> n) ->
  Generation ->
  Entity m ->
  n (TrySyncResult (Entity m))
trySync t _gc e = do
  Env _ dest _ <- Reader.ask
  case e of
    C h mc -> do
      getBranchStatus h >>= \case
        Just {} -> pure Sync.PreviouslyDone
        Nothing -> t (Codebase.branchExists dest h) >>= \case
          True -> setBranchStatus h BranchOk $> Sync.PreviouslyDone
          False -> do
            c <- t mc
            runValidateT (repairBranch c) >>= \case
              Left deps -> pure . Sync.Missing $ Foldable.toList deps
              Right c' -> do
                let h' = Causal.currentHash c'
                t $ Codebase.putBranch dest (Branch.Branch c')
                if h == h'
                  then do
                    setBranchStatus h BranchOk
                    pure Sync.Done
                  else do
                    setBranchStatus h (BranchReplaced h' c')
                    pure Sync.NonFatalError
    T h n ->
      getTermStatus h >>= \case
        Just {} -> pure Sync.PreviouslyDone
        Nothing -> do
          runExceptT (runValidateT (checkTermComponent (lift . lift . t) h n)) >>= \case
            Left status -> do
              setTermStatus h status
              pure Sync.NonFatalError
            Right (Left deps) ->
              pure . Sync.Missing $ Foldable.toList deps
            Right (Right component) -> do
              Foldable.for_ (zip component [0 ..]) \((term, typ), i) ->
                t $ Codebase.putTerm dest (Reference.Id h i n) term typ
{'fraction_non_alphanumeric': 0.09031511041270367, 'fraction_numerical': 0.0018195351914647257, 'mean_word_length': 2.8497293855460044, 'pattern_counts': {'":': 0, '<': 10, '<?xml version=': 0, '>': 82, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2766634', 'n_tokens_mistral': 3800, 'n_tokens_neox': 3727, 'n_words': 1237}