{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Codebase.Type
  ( Codebase (..),
    CodebasePath,
    LocalOrRemote (..),
  )
where

import U.Codebase.HashTags (CausalHash)
import Unison.Codebase.Branch (Branch)
import Unison.CodebasePath (CodebasePath)
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration (Decl)
import Unison.Hash (Hash)
import Unison.Prelude
import Unison.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.ShortHash (ShortHash)
import Unison.Sqlite qualified as Sqlite
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.WatchKind qualified as WK

-- | Abstract interface to a user's codebase.
data Codebase m v a = Codebase
  { -- | Get a user-defined term from the codebase.
    --
    -- Note that it is possible to call 'putTerm', then 'getTerm', and receive @Nothing@, per the semantics of
    -- 'putTerm'.
    forall (m :: * -> *) v a.
Codebase m v a -> TermReferenceId -> Transaction (Maybe (Term v a))
getTerm :: TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)),
    -- | Get the type of a user-defined term.
    --
    -- Note that it is possible to call 'putTerm', then 'getTypeOfTermImpl', and receive @Nothing@, per the semantics of
    -- 'putTerm'.
    forall (m :: * -> *) v a.
Codebase m v a -> TermReferenceId -> Transaction (Maybe (Type v a))
getTypeOfTermImpl :: TermReferenceId -> Sqlite.Transaction (Maybe (Type v a)),
    -- | Get a type declaration.
    --
    -- Note that it is possible to call 'putTypeDeclaration', then 'getTypeDeclaration', and receive @Nothing@, per the
    -- semantics of 'putTypeDeclaration'.
    forall (m :: * -> *) v a.
Codebase m v a -> TermReferenceId -> Transaction (Maybe (Decl v a))
getTypeDeclaration :: TypeReferenceId -> Sqlite.Transaction (Maybe (Decl v a)),
    -- | Get the type of a given decl.
    forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction ConstructorType
getDeclType :: TypeReference -> Sqlite.Transaction CT.ConstructorType,
    -- | Enqueue the put of a user-defined term (with its type) into the codebase, if it doesn't already exist. The
    -- implementation may choose to delay the put until all of the term's (and its type's) references are stored as
    -- well.
    forall (m :: * -> *) v a.
Codebase m v a
-> TermReferenceId -> Term v a -> Type v a -> Transaction ()
putTerm :: TermReferenceId -> Term v a -> Type v a -> Sqlite.Transaction (),
    forall (m :: * -> *) v a.
Codebase m v a -> Hash -> [(Term v a, Type v a)] -> Transaction ()
putTermComponent :: Hash -> [(Term v a, Type v a)] -> Sqlite.Transaction (),
    -- | Enqueue the put of a type declaration into the codebase, if it doesn't already exist. The implementation may
    -- choose to delay the put until all of the type declaration's references are stored as well.
    forall (m :: * -> *) v a.
Codebase m v a -> TermReferenceId -> Decl v a -> Transaction ()
putTypeDeclaration :: TypeReferenceId -> Decl v a -> Sqlite.Transaction (),
    forall (m :: * -> *) v a.
Codebase m v a -> Hash -> [Decl v a] -> Transaction ()
putTypeDeclarationComponent :: Hash -> [Decl v a] -> Sqlite.Transaction (),
    -- getTermComponent :: Hash -> m (Maybe [Term v a]),
    forall (m :: * -> *) v a.
Codebase m v a
-> Hash -> Transaction (Maybe [(Term v a, Type v a)])
getTermComponentWithTypes :: Hash -> Sqlite.Transaction (Maybe [(Term v a, Type v a)]),
    forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> m (Maybe (Branch m))
getBranchForHash :: CausalHash -> m (Maybe (Branch m)),
    -- | Put a branch into the codebase, which includes its children, its patches, and the branch itself, if they don't
    -- already exist.
    --
    -- The terms and type declarations that a branch references must already exist in the codebase.
    forall (m :: * -> *) v a. Codebase m v a -> Branch m -> m ()
putBranch :: Branch m -> m (),
    -- | @getWatch k r@ returns watch result @t@ that was previously put by @putWatch k r t@.
    forall (m :: * -> *) v a.
Codebase m v a
-> WatchKind -> TermReferenceId -> Transaction (Maybe (Term v a))
getWatch :: WK.WatchKind -> TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)),
    -- | Get the set of user-defined terms-or-constructors that have the given type.
    forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction (Set Id)
termsOfTypeImpl :: Reference -> Sqlite.Transaction (Set Referent.Id),
    -- | Get the set of user-defined terms-or-constructors mention the given type anywhere in their signature.
    forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction (Set Id)
termsMentioningTypeImpl :: Reference -> Sqlite.Transaction (Set Referent.Id),
    -- | Return the subset of the given set that has the given type.
    forall (m :: * -> *) v a.
Codebase m v a
-> TypeReference
-> Set TermReferenceId
-> Transaction (Set TermReferenceId)
filterTermsByReferenceIdHavingTypeImpl :: TypeReference -> Set Reference.Id -> Sqlite.Transaction (Set Reference.Id),
    -- | Return the subset of the given set that has the given type.
    forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Set Id -> Transaction (Set Id)
filterTermsByReferentIdHavingTypeImpl :: TypeReference -> Set Referent.Id -> Sqlite.Transaction (Set Referent.Id),
    -- | Get the set of user-defined terms-or-constructors whose hash matches the given prefix.
    forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set Id)
termReferentsByPrefix :: ShortHash -> Sqlite.Transaction (Set Referent.Id),
    -- | Acquire a new connection to the same underlying database file this codebase object connects to.
    forall (m :: * -> *) v a.
Codebase m v a -> forall x. (Connection -> m x) -> m x
withConnection :: forall x. (Sqlite.Connection -> m x) -> m x,
    -- | Acquire a new connection to the same underlying database file this codebase object connects to.
    forall (m :: * -> *) v a.
Codebase m v a -> forall x. (Connection -> IO x) -> IO x
withConnectionIO :: forall x. (Sqlite.Connection -> IO x) -> IO x,
    -- | This optimization allows us to pre-fetch a branch from SQLite into the branch cache when we know we'll need it
    -- soon, but not immediately. E.g. the user has switched a branch, but hasn't run any commands on it yet.
    --
    -- This combinator returns immediately, but warms the cache in the background with the desired branch.
    forall (m :: * -> *) v a. Codebase m v a -> CausalHash -> m ()
preloadBranch :: CausalHash -> m ()
  }

-- | Whether a codebase is local or remote.
data LocalOrRemote
  = Local
  | Remote
  deriving (Int -> LocalOrRemote -> ShowS
[LocalOrRemote] -> ShowS
LocalOrRemote -> WatchKind
(Int -> LocalOrRemote -> ShowS)
-> (LocalOrRemote -> WatchKind)
-> ([LocalOrRemote] -> ShowS)
-> Show LocalOrRemote
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalOrRemote -> ShowS
showsPrec :: Int -> LocalOrRemote -> ShowS
$cshow :: LocalOrRemote -> WatchKind
show :: LocalOrRemote -> WatchKind
$cshowList :: [LocalOrRemote] -> ShowS
showList :: [LocalOrRemote] -> ShowS
Show, LocalOrRemote -> LocalOrRemote -> Bool
(LocalOrRemote -> LocalOrRemote -> Bool)
-> (LocalOrRemote -> LocalOrRemote -> Bool) -> Eq LocalOrRemote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocalOrRemote -> LocalOrRemote -> Bool
== :: LocalOrRemote -> LocalOrRemote -> Bool
$c/= :: LocalOrRemote -> LocalOrRemote -> Bool
/= :: LocalOrRemote -> LocalOrRemote -> Bool
Eq, Eq LocalOrRemote
Eq LocalOrRemote =>
(LocalOrRemote -> LocalOrRemote -> Ordering)
-> (LocalOrRemote -> LocalOrRemote -> Bool)
-> (LocalOrRemote -> LocalOrRemote -> Bool)
-> (LocalOrRemote -> LocalOrRemote -> Bool)
-> (LocalOrRemote -> LocalOrRemote -> Bool)
-> (LocalOrRemote -> LocalOrRemote -> LocalOrRemote)
-> (LocalOrRemote -> LocalOrRemote -> LocalOrRemote)
-> Ord LocalOrRemote
LocalOrRemote -> LocalOrRemote -> Bool
LocalOrRemote -> LocalOrRemote -> Ordering
LocalOrRemote -> LocalOrRemote -> LocalOrRemote
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LocalOrRemote -> LocalOrRemote -> Ordering
compare :: LocalOrRemote -> LocalOrRemote -> Ordering
$c< :: LocalOrRemote -> LocalOrRemote -> Bool
< :: LocalOrRemote -> LocalOrRemote -> Bool
$c<= :: LocalOrRemote -> LocalOrRemote -> Bool
<= :: LocalOrRemote -> LocalOrRemote -> Bool
$c> :: LocalOrRemote -> LocalOrRemote -> Bool
> :: LocalOrRemote -> LocalOrRemote -> Bool
$c>= :: LocalOrRemote -> LocalOrRemote -> Bool
>= :: LocalOrRemote -> LocalOrRemote -> Bool
$cmax :: LocalOrRemote -> LocalOrRemote -> LocalOrRemote
max :: LocalOrRemote -> LocalOrRemote -> LocalOrRemote
$cmin :: LocalOrRemote -> LocalOrRemote -> LocalOrRemote
min :: LocalOrRemote -> LocalOrRemote -> LocalOrRemote
Ord)