{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Unison.Codebase.SqliteCodebase.Operations where
import Data.Bitraversable (bitraverse)
import Data.Either.Extra ()
import Data.List qualified as List
import Data.List.NonEmpty.Extra (NonEmpty ((:|)), maximum1)
import Data.Map qualified as Map
import Data.Maybe (fromJust)
import Data.Set qualified as Set
import Data.UUID.V4 qualified as UUID
import U.Codebase.HashTags (CausalHash (unCausalHash), PatchHash)
import U.Codebase.Reference qualified as C.Reference
import U.Codebase.Referent qualified as C.Referent
import U.Codebase.Sqlite.DbId (ObjectId)
import U.Codebase.Sqlite.DbId qualified as Db
import U.Codebase.Sqlite.ObjectType qualified as OT
import U.Codebase.Sqlite.Operations qualified as Ops
import U.Codebase.Sqlite.Project (Project (..))
import U.Codebase.Sqlite.Project qualified as Project
import U.Codebase.Sqlite.ProjectBranch (ProjectBranchRow (..))
import U.Codebase.Sqlite.Queries qualified as Q
import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle)
import Unison.Builtin qualified as Builtins
import Unison.Codebase.Branch (Branch (..))
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Patch (Patch)
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
import Unison.Codebase.SqliteCodebase.Branch.Cache (BranchCache)
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.Core.Project (ProjectBranchName (..), ProjectName (..))
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as Decl
import Unison.Hash (Hash)
import Unison.Hashing.V2.Convert qualified as Hashing
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Project (defaultBranchName)
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.ShortHash (ShortHash)
import Unison.ShortHash qualified as ShortHash
import Unison.Sqlite (Transaction)
import Unison.Sqlite qualified as Sqlite
import Unison.Sqlite.Transaction qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Util.Cache qualified as Cache
import Unison.Util.Set qualified as Set
import Unison.WatchKind qualified as UF
import UnliftIO.STM
createSchema :: Transaction ()
createSchema :: Transaction ()
createSchema = do
Transaction ()
Q.runCreateSql
Transaction ()
Q.addTempEntityTables
Transaction ()
Q.addNamespaceStatsTables
Transaction ()
Q.addReflogTable
Transaction ()
Q.fixScopedNameLookupTables
Transaction ()
Q.addProjectTables
Transaction ()
Q.addMostRecentBranchTable
Transaction ()
Q.addNameLookupMountTables
Transaction ()
Q.addMostRecentNamespaceTable
HasCallStack => Sql -> Transaction ()
Sql -> Transaction ()
Sqlite.execute Sql
insertSchemaVersionSql
Transaction ()
Q.addSquashResultTable
Transaction ()
Q.addCurrentProjectPathTable
Transaction ()
Q.addProjectBranchReflogTable
Transaction ()
Q.addProjectBranchCausalHashIdColumn
Transaction ()
Q.addProjectBranchLastAccessedColumn
Transaction ()
Q.addMergeBranchTables
Transaction ()
Q.addUpdateBranchTable
Transaction ()
Q.addDerivedDependentsByDependencyIndex
Transaction ()
Q.addUpgradeBranchTable
(CausalHash
_, CausalHashId
emptyCausalHashId) <- Transaction (CausalHash, CausalHashId)
emptyCausalHash
(Project
_, ProjectBranchRow {ProjectId
projectId :: ProjectId
$sel:projectId:ProjectBranchRow :: ProjectBranchRow -> ProjectId
projectId, ProjectBranchId
branchId :: ProjectBranchId
$sel:branchId:ProjectBranchRow :: ProjectBranchRow -> ProjectBranchId
branchId}) <-
ProjectName
-> ProjectBranchName
-> CausalHashId
-> Transaction (Project, ProjectBranchRow)
insertProjectAndBranch ProjectName
scratchProjectName ProjectBranchName
scratchBranchName CausalHashId
emptyCausalHashId
ProjectId -> ProjectBranchId -> [NameSegment] -> Transaction ()
Q.setCurrentProjectPath ProjectId
projectId ProjectBranchId
branchId []
where
scratchProjectName :: ProjectName
scratchProjectName = Text -> ProjectName
UnsafeProjectName Text
"scratch"
scratchBranchName :: ProjectBranchName
scratchBranchName = ProjectBranchName
defaultBranchName
currentSchemaVersion :: SchemaVersion
currentSchemaVersion = SchemaVersion
Q.currentSchemaVersion
insertSchemaVersionSql :: Sql
insertSchemaVersionSql =
[Sqlite.sql|
INSERT INTO schema_version (version)
VALUES (:currentSchemaVersion)
|]
data BufferEntry a = BufferEntry
{
forall a. BufferEntry a -> Maybe ConstructorId
beComponentTargetSize :: Maybe Word64,
forall a. BufferEntry a -> Map ConstructorId a
beComponent :: Map Reference.Pos a,
forall a. BufferEntry a -> Set Hash
beMissingDependencies :: Set Hash,
forall a. BufferEntry a -> Set Hash
beWaitingDependents :: Set Hash
}
deriving (BufferEntry a -> BufferEntry a -> Bool
(BufferEntry a -> BufferEntry a -> Bool)
-> (BufferEntry a -> BufferEntry a -> Bool) -> Eq (BufferEntry a)
forall a. Eq a => BufferEntry a -> BufferEntry a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => BufferEntry a -> BufferEntry a -> Bool
== :: BufferEntry a -> BufferEntry a -> Bool
$c/= :: forall a. Eq a => BufferEntry a -> BufferEntry a -> Bool
/= :: BufferEntry a -> BufferEntry a -> Bool
Eq, Int -> BufferEntry a -> ShowS
[BufferEntry a] -> ShowS
BufferEntry a -> WatchKind
(Int -> BufferEntry a -> ShowS)
-> (BufferEntry a -> WatchKind)
-> ([BufferEntry a] -> ShowS)
-> Show (BufferEntry a)
forall a. Show a => Int -> BufferEntry a -> ShowS
forall a. Show a => [BufferEntry a] -> ShowS
forall a. Show a => BufferEntry a -> WatchKind
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BufferEntry a -> ShowS
showsPrec :: Int -> BufferEntry a -> ShowS
$cshow :: forall a. Show a => BufferEntry a -> WatchKind
show :: BufferEntry a -> WatchKind
$cshowList :: forall a. Show a => [BufferEntry a] -> ShowS
showList :: [BufferEntry a] -> ShowS
Show)
prettyBufferEntry :: (Show a) => Hash -> BufferEntry a -> String
prettyBufferEntry :: forall a. Show a => Hash -> BufferEntry a -> WatchKind
prettyBufferEntry (Hash
h :: Hash) BufferEntry {Maybe ConstructorId
Map ConstructorId a
Set Hash
$sel:beComponentTargetSize:BufferEntry :: forall a. BufferEntry a -> Maybe ConstructorId
$sel:beComponent:BufferEntry :: forall a. BufferEntry a -> Map ConstructorId a
$sel:beMissingDependencies:BufferEntry :: forall a. BufferEntry a -> Set Hash
$sel:beWaitingDependents:BufferEntry :: forall a. BufferEntry a -> Set Hash
beComponentTargetSize :: Maybe ConstructorId
beComponent :: Map ConstructorId a
beMissingDependencies :: Set Hash
beWaitingDependents :: Set Hash
..} =
WatchKind
"BufferEntry "
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ Hash -> WatchKind
forall a. Show a => a -> WatchKind
show Hash
h
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
"\n"
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
" { beComponentTargetSize = "
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe ConstructorId -> WatchKind
forall a. Show a => a -> WatchKind
show Maybe ConstructorId
beComponentTargetSize
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
"\n"
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
" , beComponent = "
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ if Map ConstructorId a -> Int
forall k a. Map k a -> Int
Map.size Map ConstructorId a
beComponent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
then [(ConstructorId, a)] -> WatchKind
forall a. Show a => a -> WatchKind
show ([(ConstructorId, a)] -> WatchKind)
-> [(ConstructorId, a)] -> WatchKind
forall a b. (a -> b) -> a -> b
$ Map ConstructorId a -> [(ConstructorId, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ConstructorId a
beComponent
else
[(ConstructorId, a)]
-> Maybe WatchKind -> WatchKind -> Maybe WatchKind -> WatchKind
forall (f :: * -> *) a.
(Foldable f, Show a) =>
f a -> Maybe WatchKind -> WatchKind -> Maybe WatchKind -> WatchKind
mkString (Map ConstructorId a -> [(ConstructorId, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ConstructorId a
beComponent) (WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
"\n [ ") WatchKind
" , " (WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
"]\n")
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
" , beMissingDependencies ="
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ if Set Hash -> Int
forall a. Set a -> Int
Set.size Set Hash
beMissingDependencies Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
then [Hash] -> WatchKind
forall a. Show a => a -> WatchKind
show ([Hash] -> WatchKind) -> [Hash] -> WatchKind
forall a b. (a -> b) -> a -> b
$ Set Hash -> [Hash]
forall a. Set a -> [a]
Set.toList Set Hash
beMissingDependencies
else
[Hash]
-> Maybe WatchKind -> WatchKind -> Maybe WatchKind -> WatchKind
forall (f :: * -> *) a.
(Foldable f, Show a) =>
f a -> Maybe WatchKind -> WatchKind -> Maybe WatchKind -> WatchKind
mkString (Set Hash -> [Hash]
forall a. Set a -> [a]
Set.toList Set Hash
beMissingDependencies) (WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
"\n [ ") WatchKind
" , " (WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
"]\n")
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
" , beWaitingDependents ="
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ if Set Hash -> Int
forall a. Set a -> Int
Set.size Set Hash
beWaitingDependents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
then [Hash] -> WatchKind
forall a. Show a => a -> WatchKind
show ([Hash] -> WatchKind) -> [Hash] -> WatchKind
forall a b. (a -> b) -> a -> b
$ Set Hash -> [Hash]
forall a. Set a -> [a]
Set.toList Set Hash
beWaitingDependents
else
[Hash]
-> Maybe WatchKind -> WatchKind -> Maybe WatchKind -> WatchKind
forall (f :: * -> *) a.
(Foldable f, Show a) =>
f a -> Maybe WatchKind -> WatchKind -> Maybe WatchKind -> WatchKind
mkString (Set Hash -> [Hash]
forall a. Set a -> [a]
Set.toList Set Hash
beWaitingDependents) (WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
"\n [ ") WatchKind
" , " (WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
"]\n")
WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
" }"
where
mkString :: (Foldable f, Show a) => f a -> Maybe String -> String -> Maybe String -> String
mkString :: forall (f :: * -> *) a.
(Foldable f, Show a) =>
f a -> Maybe WatchKind -> WatchKind -> Maybe WatchKind -> WatchKind
mkString f a
as Maybe WatchKind
start WatchKind
middle Maybe WatchKind
end =
WatchKind -> Maybe WatchKind -> WatchKind
forall a. a -> Maybe a -> a
fromMaybe WatchKind
"" Maybe WatchKind
start WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind -> [WatchKind] -> WatchKind
forall a. [a] -> [[a]] -> [a]
List.intercalate WatchKind
middle (a -> WatchKind
forall a. Show a => a -> WatchKind
show (a -> WatchKind) -> [a] -> [WatchKind]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
as) WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind -> Maybe WatchKind -> WatchKind
forall a. a -> Maybe a -> a
fromMaybe WatchKind
"" Maybe WatchKind
end
type TermBufferEntry = BufferEntry (Term Symbol Ann, Type Symbol Ann)
type DeclBufferEntry = BufferEntry (Decl Symbol Ann)
getBuffer :: TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
getBuffer :: forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
getBuffer TVar (Map Hash (BufferEntry a))
tv Hash
h = do
(Hash -> Map Hash (BufferEntry a) -> Maybe (BufferEntry a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Hash
h (Map Hash (BufferEntry a) -> Maybe (BufferEntry a))
-> IO (Map Hash (BufferEntry a)) -> IO (Maybe (BufferEntry a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map Hash (BufferEntry a)) -> IO (Map Hash (BufferEntry a))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map Hash (BufferEntry a))
tv) IO (Maybe (BufferEntry a))
-> (Maybe (BufferEntry a) -> BufferEntry a) -> IO (BufferEntry a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Just BufferEntry a
e -> BufferEntry a
e
Maybe (BufferEntry a)
Nothing -> Maybe ConstructorId
-> Map ConstructorId a -> Set Hash -> Set Hash -> BufferEntry a
forall a.
Maybe ConstructorId
-> Map ConstructorId a -> Set Hash -> Set Hash -> BufferEntry a
BufferEntry Maybe ConstructorId
forall a. Maybe a
Nothing Map ConstructorId a
forall k a. Map k a
Map.empty Set Hash
forall a. Set a
Set.empty Set Hash
forall a. Set a
Set.empty
putBuffer :: TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
putBuffer :: forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
putBuffer TVar (Map Hash (BufferEntry a))
tv Hash
h BufferEntry a
e =
STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map Hash (BufferEntry a))
-> (Map Hash (BufferEntry a) -> Map Hash (BufferEntry a)) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (Map Hash (BufferEntry a))
tv (Hash
-> BufferEntry a
-> Map Hash (BufferEntry a)
-> Map Hash (BufferEntry a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Hash
h BufferEntry a
e)
removeBuffer :: TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
removeBuffer :: forall a. TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
removeBuffer TVar (Map Hash (BufferEntry a))
tv Hash
h =
STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map Hash (BufferEntry a))
-> (Map Hash (BufferEntry a) -> Map Hash (BufferEntry a)) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (Map Hash (BufferEntry a))
tv (Hash -> Map Hash (BufferEntry a) -> Map Hash (BufferEntry a)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Hash
h)
addBufferDependent :: Hash -> TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
addBufferDependent :: forall a. Hash -> TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
addBufferDependent Hash
dependent TVar (Map Hash (BufferEntry a))
tv Hash
dependency = do
BufferEntry a
be <- TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
getBuffer TVar (Map Hash (BufferEntry a))
tv Hash
dependency
TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
putBuffer TVar (Map Hash (BufferEntry a))
tv Hash
dependency BufferEntry a
be {beWaitingDependents = Set.insert dependent $ beWaitingDependents be}
tryFlushBuffer ::
forall a.
(Show a) =>
TVar (Map Hash (BufferEntry a)) ->
(Hash -> [a] -> Transaction ()) ->
(Hash -> Transaction ()) ->
Hash ->
Transaction ()
tryFlushBuffer :: forall a.
Show a =>
TVar (Map Hash (BufferEntry a))
-> (Hash -> [a] -> Transaction ())
-> (Hash -> Transaction ())
-> Hash
-> Transaction ()
tryFlushBuffer TVar (Map Hash (BufferEntry a))
buf Hash -> [a] -> Transaction ()
saveComponent Hash -> Transaction ()
tryWaiting Hash
h =
Transaction Bool -> Transaction () -> Transaction ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Hash -> Transaction Bool
Ops.objectExistsForHash Hash
h) do
BufferEntry Maybe ConstructorId
size Map ConstructorId a
comp (Hash -> Set Hash -> Set Hash
forall a. Ord a => a -> Set a -> Set a
Set.delete Hash
h -> Set Hash
missing) Set Hash
waiting <- IO (BufferEntry a) -> Transaction (BufferEntry a)
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
getBuffer TVar (Map Hash (BufferEntry a))
buf Hash
h)
case Maybe ConstructorId
size of
Just ConstructorId
size -> do
[Hash]
missing' <- (Hash -> Transaction Bool) -> [Hash] -> Transaction [Hash]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> Transaction Bool -> Transaction Bool
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Transaction Bool -> Transaction Bool)
-> (Hash -> Transaction Bool) -> Hash -> Transaction Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Transaction Bool
Ops.objectExistsForHash) (Set Hash -> [Hash]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Hash
missing)
if [Hash] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Hash]
missing' Bool -> Bool -> Bool
&& ConstructorId
size ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map ConstructorId a -> Int
forall a. Map ConstructorId a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map ConstructorId a
comp)
then do
Hash -> [a] -> Transaction ()
saveComponent Hash
h (Map ConstructorId a -> [a]
forall a. Map ConstructorId a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map ConstructorId a
comp)
IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
forall a. TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
removeBuffer TVar (Map Hash (BufferEntry a))
buf Hash
h)
(Hash -> Transaction ()) -> Set Hash -> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Hash -> Transaction ()
tryWaiting Set Hash
waiting
else IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO do
TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
putBuffer TVar (Map Hash (BufferEntry a))
buf Hash
h (BufferEntry a -> IO ()) -> BufferEntry a -> IO ()
forall a b. (a -> b) -> a -> b
$
Maybe ConstructorId
-> Map ConstructorId a -> Set Hash -> Set Hash -> BufferEntry a
forall a.
Maybe ConstructorId
-> Map ConstructorId a -> Set Hash -> Set Hash -> BufferEntry a
BufferEntry (ConstructorId -> Maybe ConstructorId
forall a. a -> Maybe a
Just ConstructorId
size) Map ConstructorId a
comp ([Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList [Hash]
missing') Set Hash
waiting
Maybe ConstructorId
Nothing ->
() -> Transaction ()
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getTerm ::
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
Reference.Id ->
Transaction (Maybe (Term Symbol Ann))
getTerm :: (Reference -> Transaction ConstructorType)
-> Id -> Transaction (Maybe (Term Symbol Ann))
getTerm Reference -> Transaction ConstructorType
doGetDeclType (Reference.Id Hash
h ConstructorId
i) =
MaybeT Transaction (Term Symbol Ann)
-> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
Term Symbol
term2 <- Id -> MaybeT Transaction (Term Symbol)
Ops.loadTermByReference (Hash -> ConstructorId -> Id
forall h. h -> ConstructorId -> Id' h
C.Reference.Id Hash
h ConstructorId
i)
Transaction (Term Symbol Ann)
-> MaybeT Transaction (Term Symbol Ann)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Hash
-> (Reference -> Transaction ConstructorType)
-> Term Symbol
-> Transaction (Term Symbol Ann)
forall (m :: * -> *).
Monad m =>
Hash
-> (Reference -> m ConstructorType)
-> Term Symbol
-> m (Term Symbol Ann)
Cv.term2to1 Hash
h Reference -> Transaction ConstructorType
doGetDeclType Term Symbol
term2)
getDeclType :: C.Reference.Reference -> Transaction CT.ConstructorType
getDeclType :: Reference -> Transaction ConstructorType
getDeclType = \case
C.Reference.ReferenceBuiltin Text
t -> ConstructorType -> Transaction ConstructorType
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ConstructorType
Builtins.expectBuiltinConstructorType Text
t)
C.Reference.ReferenceDerived Id
i -> Id -> Transaction ConstructorType
expectDeclTypeById Id
i
expectDeclTypeById :: C.Reference.Id -> Transaction CT.ConstructorType
expectDeclTypeById :: Id -> Transaction ConstructorType
expectDeclTypeById = (DeclType -> ConstructorType)
-> Transaction DeclType -> Transaction ConstructorType
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DeclType -> ConstructorType
Cv.decltype2to1 (Transaction DeclType -> Transaction ConstructorType)
-> (Id -> Transaction DeclType)
-> Id
-> Transaction ConstructorType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Transaction DeclType
Ops.expectDeclTypeById
getTypeOfTermImpl :: Reference.Id -> Transaction (Maybe (Type Symbol Ann))
getTypeOfTermImpl :: Id -> Transaction (Maybe (Type Symbol Ann))
getTypeOfTermImpl (Reference.Id Hash
h ConstructorId
i) =
MaybeT Transaction (Type Symbol Ann)
-> Transaction (Maybe (Type Symbol Ann))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
Type Symbol
type2 <- Id -> MaybeT Transaction (Type Symbol)
Ops.loadTypeOfTermByTermReference (Hash -> ConstructorId -> Id
forall h. h -> ConstructorId -> Id' h
C.Reference.Id Hash
h ConstructorId
i)
pure (Type Symbol -> Type Symbol Ann
Cv.ttype2to1 Type Symbol
type2)
getTermComponentWithTypes ::
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
Hash ->
Transaction (Maybe [(Term Symbol Ann, Type Symbol Ann)])
getTermComponentWithTypes :: (Reference -> Transaction ConstructorType)
-> Hash -> Transaction (Maybe [(Term Symbol Ann, Type Symbol Ann)])
getTermComponentWithTypes Reference -> Transaction ConstructorType
doGetDeclType Hash
h =
MaybeT Transaction [(Term Symbol Ann, Type Symbol Ann)]
-> Transaction (Maybe [(Term Symbol Ann, Type Symbol Ann)])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
[(Term Symbol, Type Symbol)]
tms <- Hash -> MaybeT Transaction [(Term Symbol, Type Symbol)]
Ops.loadTermComponent Hash
h
[(Term Symbol, Type Symbol)]
-> ((Term Symbol, Type Symbol)
-> MaybeT Transaction (Term Symbol Ann, Type Symbol Ann))
-> MaybeT Transaction [(Term Symbol Ann, Type Symbol Ann)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Term Symbol, Type Symbol)]
tms ((Term Symbol -> MaybeT Transaction (Term Symbol Ann))
-> (Type Symbol -> MaybeT Transaction (Type Symbol Ann))
-> (Term Symbol, Type Symbol)
-> MaybeT Transaction (Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Transaction (Term Symbol Ann)
-> MaybeT Transaction (Term Symbol Ann)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (Term Symbol Ann)
-> MaybeT Transaction (Term Symbol Ann))
-> (Term Symbol -> Transaction (Term Symbol Ann))
-> Term Symbol
-> MaybeT Transaction (Term Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash
-> (Reference -> Transaction ConstructorType)
-> Term Symbol
-> Transaction (Term Symbol Ann)
forall (m :: * -> *).
Monad m =>
Hash
-> (Reference -> m ConstructorType)
-> Term Symbol
-> m (Term Symbol Ann)
Cv.term2to1 Hash
h Reference -> Transaction ConstructorType
doGetDeclType) (Type Symbol Ann -> MaybeT Transaction (Type Symbol Ann)
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type Symbol Ann -> MaybeT Transaction (Type Symbol Ann))
-> (Type Symbol -> Type Symbol Ann)
-> Type Symbol
-> MaybeT Transaction (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Symbol -> Type Symbol Ann
Cv.ttype2to1))
getTypeDeclaration :: Reference.Id -> Transaction (Maybe (Decl Symbol Ann))
getTypeDeclaration :: Id -> Transaction (Maybe (Decl Symbol Ann))
getTypeDeclaration (Reference.Id Hash
h ConstructorId
i) =
MaybeT Transaction (Decl Symbol Ann)
-> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
Decl Symbol
decl2 <- Id -> MaybeT Transaction (Decl Symbol)
Ops.loadDeclByReference (Hash -> ConstructorId -> Id
forall h. h -> ConstructorId -> Id' h
C.Reference.Id Hash
h ConstructorId
i)
pure (Hash -> Decl Symbol -> Decl Symbol Ann
Cv.decl2to1 Hash
h Decl Symbol
decl2)
getDeclComponent :: Hash -> Transaction (Maybe [Decl Symbol Ann])
getDeclComponent :: Hash -> Transaction (Maybe [Decl Symbol Ann])
getDeclComponent Hash
h =
MaybeT Transaction [Decl Symbol Ann]
-> Transaction (Maybe [Decl Symbol Ann])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
[Decl Symbol]
decl2 <- Hash -> MaybeT Transaction [Decl Symbol]
Ops.loadDeclComponent Hash
h
pure ((Decl Symbol -> Decl Symbol Ann)
-> [Decl Symbol] -> [Decl Symbol Ann]
forall a b. (a -> b) -> [a] -> [b]
map (Hash -> Decl Symbol -> Decl Symbol Ann
Cv.decl2to1 Hash
h) [Decl Symbol]
decl2)
expectDeclComponent :: (HasCallStack) => Hash -> Transaction [Decl Symbol Ann]
expectDeclComponent :: HasCallStack => Hash -> Transaction [Decl Symbol Ann]
expectDeclComponent Hash
hash =
Hash -> Transaction (Maybe [Decl Symbol Ann])
getDeclComponent Hash
hash Transaction (Maybe [Decl Symbol Ann])
-> (Maybe [Decl Symbol Ann] -> [Decl Symbol Ann])
-> Transaction [Decl Symbol Ann]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Maybe [Decl Symbol Ann]
Nothing -> WatchKind -> [Decl Symbol Ann]
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> ShowS
reportBug WatchKind
"E101611" (WatchKind
"decl component " WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ Hash -> WatchKind
forall a. Show a => a -> WatchKind
show Hash
hash WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ WatchKind
" not found"))
Just [Decl Symbol Ann]
decls -> [Decl Symbol Ann]
decls
putTermComponent ::
TVar (Map Hash TermBufferEntry) ->
TVar (Map Hash DeclBufferEntry) ->
Hash ->
[(Term Symbol Ann, Type Symbol Ann)] ->
Transaction ()
putTermComponent :: TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry)
-> Hash
-> [(Term Symbol Ann, Type Symbol Ann)]
-> Transaction ()
putTermComponent TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Hash
h [(Term Symbol Ann, Type Symbol Ann)]
component =
Transaction Bool -> Transaction () -> Transaction ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Hash -> Transaction Bool
Ops.objectExistsForHash Hash
h) do
[(Id, (Term Symbol Ann, Type Symbol Ann))]
-> ((Id, (Term Symbol Ann, Type Symbol Ann)) -> Transaction ())
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Hash
-> [(Term Symbol Ann, Type Symbol Ann)]
-> [(Id, (Term Symbol Ann, Type Symbol Ann))]
forall a. Hash -> [a] -> [(Id, a)]
Reference.componentFor Hash
h [(Term Symbol Ann, Type Symbol Ann)]
component) \(Id
ref, (Term Symbol Ann
tm, Type Symbol Ann
tp)) -> do
TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry)
-> Id
-> Term Symbol Ann
-> Type Symbol Ann
-> Transaction ()
putTerm_ TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Id
ref Term Symbol Ann
tm Type Symbol Ann
tp
TVar (Map Hash TermBufferEntry) -> Hash -> Transaction ()
tryFlushTermBuffer TVar (Map Hash TermBufferEntry)
termBuffer Hash
h
putTerm ::
TVar (Map Hash TermBufferEntry) ->
TVar (Map Hash DeclBufferEntry) ->
Reference.Id ->
Term Symbol Ann ->
Type Symbol Ann ->
Transaction ()
putTerm :: TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry)
-> Id
-> Term Symbol Ann
-> Type Symbol Ann
-> Transaction ()
putTerm TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer ref :: Id
ref@(Reference.Id Hash
h ConstructorId
_) Term Symbol Ann
tm Type Symbol Ann
tp =
Transaction Bool -> Transaction () -> Transaction ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Hash -> Transaction Bool
Ops.objectExistsForHash Hash
h) do
TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry)
-> Id
-> Term Symbol Ann
-> Type Symbol Ann
-> Transaction ()
putTerm_ TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Id
ref Term Symbol Ann
tm Type Symbol Ann
tp
TVar (Map Hash TermBufferEntry) -> Hash -> Transaction ()
tryFlushTermBuffer TVar (Map Hash TermBufferEntry)
termBuffer Hash
h
putTerm_ ::
TVar (Map Hash TermBufferEntry) ->
TVar (Map Hash DeclBufferEntry) ->
Reference.Id ->
Term Symbol Ann ->
Type Symbol Ann ->
Transaction ()
putTerm_ :: TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry)
-> Id
-> Term Symbol Ann
-> Type Symbol Ann
-> Transaction ()
putTerm_ TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer (Reference.Id Hash
h ConstructorId
i) Term Symbol Ann
tm Type Symbol Ann
tp = do
BufferEntry Maybe ConstructorId
size Map ConstructorId (Term Symbol Ann, Type Symbol Ann)
comp Set Hash
missing Set Hash
waiting <- IO TermBufferEntry -> Transaction TermBufferEntry
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (TVar (Map Hash TermBufferEntry) -> Hash -> IO TermBufferEntry
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
getBuffer TVar (Map Hash TermBufferEntry)
termBuffer Hash
h)
let termDependencies :: [Reference]
termDependencies = Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList (Set Reference -> [Reference]) -> Set Reference -> [Reference]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Set Reference
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set Reference
Term.termDependencies Term Symbol Ann
tm
let size' :: Maybe ConstructorId
size' = Maybe ConstructorId -> Maybe ConstructorId -> Maybe ConstructorId
forall a. Ord a => a -> a -> a
max Maybe ConstructorId
size (ConstructorId -> Maybe ConstructorId
forall a. a -> Maybe a
Just (ConstructorId -> Maybe ConstructorId)
-> ConstructorId -> Maybe ConstructorId
forall a b. (a -> b) -> a -> b
$ ConstructorId
biggestSelfReference ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
1)
where
biggestSelfReference :: ConstructorId
biggestSelfReference =
NonEmpty ConstructorId -> ConstructorId
forall a. Ord a => NonEmpty a -> a
maximum1 (NonEmpty ConstructorId -> ConstructorId)
-> NonEmpty ConstructorId -> ConstructorId
forall a b. (a -> b) -> a -> b
$
ConstructorId
i ConstructorId -> [ConstructorId] -> NonEmpty ConstructorId
forall a. a -> [a] -> NonEmpty a
:| [ConstructorId
i' | Reference.Derived Hash
h' ConstructorId
i' <- [Reference]
termDependencies, Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h']
let comp' :: Map ConstructorId (Term Symbol Ann, Type Symbol Ann)
comp' = ConstructorId
-> (Term Symbol Ann, Type Symbol Ann)
-> Map ConstructorId (Term Symbol Ann, Type Symbol Ann)
-> Map ConstructorId (Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ConstructorId
i (Term Symbol Ann
tm, Type Symbol Ann
tp) Map ConstructorId (Term Symbol Ann, Type Symbol Ann)
comp
[Hash]
missingTerms' <-
(Hash -> Transaction Bool) -> [Hash] -> Transaction [Hash]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
((Bool -> Bool) -> Transaction Bool -> Transaction Bool
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Transaction Bool -> Transaction Bool)
-> (Hash -> Transaction Bool) -> Hash -> Transaction Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Transaction Bool
Ops.objectExistsForHash)
[Hash
h | Reference.Derived Hash
h ConstructorId
_i <- [Reference]
termDependencies]
[Hash]
missingTypes' <-
(Hash -> Transaction Bool) -> [Hash] -> Transaction [Hash]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> Transaction Bool -> Transaction Bool
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Transaction Bool -> Transaction Bool)
-> (Hash -> Transaction Bool) -> Hash -> Transaction Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Transaction Bool
Ops.objectExistsForHash) ([Hash] -> Transaction [Hash]) -> [Hash] -> Transaction [Hash]
forall a b. (a -> b) -> a -> b
$
[Hash
h | Reference.Derived Hash
h ConstructorId
_i <- Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList (Set Reference -> [Reference]) -> Set Reference -> [Reference]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Set Reference
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set Reference
Term.typeDependencies Term Symbol Ann
tm]
[Hash] -> [Hash] -> [Hash]
forall a. [a] -> [a] -> [a]
++ [Hash
h | Reference.Derived Hash
h ConstructorId
_i <- Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList (Set Reference -> [Reference]) -> Set Reference -> [Reference]
forall a b. (a -> b) -> a -> b
$ Type Symbol Ann -> Set Reference
forall v a. Ord v => Type v a -> Set Reference
Type.dependencies Type Symbol Ann
tp]
let missing' :: Set Hash
missing' = Set Hash
missing Set Hash -> Set Hash -> Set Hash
forall a. Semigroup a => a -> a -> a
<> [Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList ([Hash]
missingTerms' [Hash] -> [Hash] -> [Hash]
forall a. Semigroup a => a -> a -> a
<> [Hash]
missingTypes')
IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO do
(Hash -> IO ()) -> [Hash] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Hash -> TVar (Map Hash TermBufferEntry) -> Hash -> IO ()
forall a. Hash -> TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
addBufferDependent Hash
h TVar (Map Hash TermBufferEntry)
termBuffer) [Hash]
missingTerms'
(Hash -> IO ()) -> [Hash] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Hash -> TVar (Map Hash DeclBufferEntry) -> Hash -> IO ()
forall a. Hash -> TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
addBufferDependent Hash
h TVar (Map Hash DeclBufferEntry)
declBuffer) [Hash]
missingTypes'
TVar (Map Hash TermBufferEntry) -> Hash -> TermBufferEntry -> IO ()
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
putBuffer TVar (Map Hash TermBufferEntry)
termBuffer Hash
h (Maybe ConstructorId
-> Map ConstructorId (Term Symbol Ann, Type Symbol Ann)
-> Set Hash
-> Set Hash
-> TermBufferEntry
forall a.
Maybe ConstructorId
-> Map ConstructorId a -> Set Hash -> Set Hash -> BufferEntry a
BufferEntry Maybe ConstructorId
size' Map ConstructorId (Term Symbol Ann, Type Symbol Ann)
comp' Set Hash
missing' Set Hash
waiting)
tryFlushTermBuffer :: TVar (Map Hash TermBufferEntry) -> Hash -> Transaction ()
tryFlushTermBuffer :: TVar (Map Hash TermBufferEntry) -> Hash -> Transaction ()
tryFlushTermBuffer TVar (Map Hash TermBufferEntry)
termBuffer =
let loop :: Hash -> Transaction ()
loop Hash
h =
TVar (Map Hash TermBufferEntry)
-> (Hash -> [(Term Symbol Ann, Type Symbol Ann)] -> Transaction ())
-> (Hash -> Transaction ())
-> Hash
-> Transaction ()
forall a.
Show a =>
TVar (Map Hash (BufferEntry a))
-> (Hash -> [a] -> Transaction ())
-> (Hash -> Transaction ())
-> Hash
-> Transaction ()
tryFlushBuffer
TVar (Map Hash TermBufferEntry)
termBuffer
(\Hash
h2 [(Term Symbol Ann, Type Symbol Ann)]
component -> Transaction ObjectId -> Transaction ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Transaction ObjectId -> Transaction ())
-> Transaction ObjectId -> Transaction ()
forall a b. (a -> b) -> a -> b
$ HashHandle
-> Maybe ByteString
-> Hash
-> [(Term Symbol, Type Symbol)]
-> Transaction ObjectId
Q.saveTermComponent HashHandle
v2HashHandle Maybe ByteString
forall a. Maybe a
Nothing Hash
h2 (Hash
-> [(Term Symbol Ann, Type Symbol Ann)]
-> [(Term Symbol, Type Symbol)]
forall a.
Hash
-> [(Term Symbol Ann, Type Symbol a)]
-> [(Term Symbol, Type Symbol)]
Cv.termComponent1to2 Hash
h [(Term Symbol Ann, Type Symbol Ann)]
component))
Hash -> Transaction ()
loop
Hash
h
in Hash -> Transaction ()
loop
addDeclComponentTypeIndex :: ObjectId -> [[Type Symbol Ann]] -> Transaction ()
addDeclComponentTypeIndex :: ObjectId -> [[Type Symbol Ann]] -> Transaction ()
addDeclComponentTypeIndex ObjectId
oId [[Type Symbol Ann]]
ctorss =
[([Type Symbol Ann], ConstructorId)]
-> (([Type Symbol Ann], ConstructorId) -> Transaction ())
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([[Type Symbol Ann]]
ctorss [[Type Symbol Ann]]
-> [ConstructorId] -> [([Type Symbol Ann], ConstructorId)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [ConstructorId
0 ..]) \([Type Symbol Ann]
ctors, ConstructorId
i) ->
[(Type Symbol Ann, ConstructorId)]
-> ((Type Symbol Ann, ConstructorId) -> Transaction ())
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Type Symbol Ann]
ctors [Type Symbol Ann]
-> [ConstructorId] -> [(Type Symbol Ann, ConstructorId)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [ConstructorId
0 ..]) \(Type Symbol Ann
tp, ConstructorId
j) -> do
let self :: Id' ObjectId ObjectId
self = Id' ObjectId -> ConstructorId -> Id' ObjectId ObjectId
forall hTm hTp. Id' hTp -> ConstructorId -> Id' hTm hTp
C.Referent.ConId (ObjectId -> ConstructorId -> Id' ObjectId
forall h. h -> ConstructorId -> Id' h
C.Reference.Id ObjectId
oId ConstructorId
i) ConstructorId
j
typeForIndexing :: Reference
typeForIndexing = Type Symbol Ann -> Reference
forall v a. Var v => Type v a -> Reference
Hashing.typeToReference Type Symbol Ann
tp
typeMentionsForIndexing :: Set Reference
typeMentionsForIndexing = Type Symbol Ann -> Set Reference
forall v a. Var v => Type v a -> Set Reference
Hashing.typeToReferenceMentions Type Symbol Ann
tp
Id' ObjectId ObjectId -> Reference -> Transaction ()
Ops.addTypeToIndexForTerm Id' ObjectId ObjectId
self (Reference -> Reference
Cv.reference1to2 Reference
typeForIndexing)
Id' ObjectId ObjectId -> Set Reference -> Transaction ()
Ops.addTypeMentionsToIndexForTerm Id' ObjectId ObjectId
self ((Reference -> Reference) -> Set Reference -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Reference
Cv.reference1to2 Set Reference
typeMentionsForIndexing)
putTypeDeclarationComponent ::
TVar (Map Hash TermBufferEntry) ->
TVar (Map Hash DeclBufferEntry) ->
Hash ->
[Decl Symbol Ann] ->
Transaction ()
putTypeDeclarationComponent :: TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry)
-> Hash
-> [Decl Symbol Ann]
-> Transaction ()
putTypeDeclarationComponent TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Hash
h [Decl Symbol Ann]
decls =
Transaction Bool -> Transaction () -> Transaction ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Hash -> Transaction Bool
Ops.objectExistsForHash Hash
h) do
[(Id, Decl Symbol Ann)]
-> ((Id, Decl Symbol Ann) -> Transaction ()) -> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Hash -> [Decl Symbol Ann] -> [(Id, Decl Symbol Ann)]
forall a. Hash -> [a] -> [(Id, a)]
Reference.componentFor Hash
h [Decl Symbol Ann]
decls) \(Id
ref, Decl Symbol Ann
decl) ->
TVar (Map Hash DeclBufferEntry)
-> Id -> Decl Symbol Ann -> Transaction ()
putTypeDeclaration_ TVar (Map Hash DeclBufferEntry)
declBuffer Id
ref Decl Symbol Ann
decl
TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry) -> Hash -> Transaction ()
tryFlushDeclBuffer TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Hash
h
putTypeDeclaration ::
TVar (Map Hash TermBufferEntry) ->
TVar (Map Hash DeclBufferEntry) ->
Reference.Id ->
Decl Symbol Ann ->
Transaction ()
putTypeDeclaration :: TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry)
-> Id
-> Decl Symbol Ann
-> Transaction ()
putTypeDeclaration TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer ref :: Id
ref@(Reference.Id Hash
h ConstructorId
_) Decl Symbol Ann
decl = do
Transaction Bool -> Transaction () -> Transaction ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Hash -> Transaction Bool
Ops.objectExistsForHash Hash
h) do
TVar (Map Hash DeclBufferEntry)
-> Id -> Decl Symbol Ann -> Transaction ()
putTypeDeclaration_ TVar (Map Hash DeclBufferEntry)
declBuffer Id
ref Decl Symbol Ann
decl
TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry) -> Hash -> Transaction ()
tryFlushDeclBuffer TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Hash
h
putTypeDeclaration_ ::
TVar (Map Hash DeclBufferEntry) ->
Reference.Id ->
Decl Symbol Ann ->
Transaction ()
putTypeDeclaration_ :: TVar (Map Hash DeclBufferEntry)
-> Id -> Decl Symbol Ann -> Transaction ()
putTypeDeclaration_ TVar (Map Hash DeclBufferEntry)
declBuffer (Reference.Id Hash
h ConstructorId
i) Decl Symbol Ann
decl = do
BufferEntry Maybe ConstructorId
size Map ConstructorId (Decl Symbol Ann)
comp Set Hash
missing Set Hash
waiting <- IO DeclBufferEntry -> Transaction DeclBufferEntry
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (TVar (Map Hash DeclBufferEntry) -> Hash -> IO DeclBufferEntry
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> IO (BufferEntry a)
getBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Hash
h)
let declDependencies :: [Reference]
declDependencies = Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList (Set Reference -> [Reference]) -> Set Reference -> [Reference]
forall a b. (a -> b) -> a -> b
$ Decl Symbol Ann -> Set Reference
forall v a. Ord v => Decl v a -> Set Reference
Decl.declTypeDependencies Decl Symbol Ann
decl
let size' :: Maybe ConstructorId
size' = Maybe ConstructorId -> Maybe ConstructorId -> Maybe ConstructorId
forall a. Ord a => a -> a -> a
max Maybe ConstructorId
size (ConstructorId -> Maybe ConstructorId
forall a. a -> Maybe a
Just (ConstructorId -> Maybe ConstructorId)
-> ConstructorId -> Maybe ConstructorId
forall a b. (a -> b) -> a -> b
$ ConstructorId
biggestSelfReference ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
1)
where
biggestSelfReference :: ConstructorId
biggestSelfReference =
NonEmpty ConstructorId -> ConstructorId
forall a. Ord a => NonEmpty a -> a
maximum1 (NonEmpty ConstructorId -> ConstructorId)
-> NonEmpty ConstructorId -> ConstructorId
forall a b. (a -> b) -> a -> b
$
ConstructorId
i ConstructorId -> [ConstructorId] -> NonEmpty ConstructorId
forall a. a -> [a] -> NonEmpty a
:| [ConstructorId
i' | Reference.Derived Hash
h' ConstructorId
i' <- [Reference]
declDependencies, Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h']
let comp' :: Map ConstructorId (Decl Symbol Ann)
comp' = ConstructorId
-> Decl Symbol Ann
-> Map ConstructorId (Decl Symbol Ann)
-> Map ConstructorId (Decl Symbol Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ConstructorId
i Decl Symbol Ann
decl Map ConstructorId (Decl Symbol Ann)
comp
[Hash]
moreMissing <-
(Hash -> Transaction Bool) -> [Hash] -> Transaction [Hash]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> Transaction Bool -> Transaction Bool
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Transaction Bool -> Transaction Bool)
-> (Hash -> Transaction Bool) -> Hash -> Transaction Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Transaction Bool
Ops.objectExistsForHash) ([Hash] -> Transaction [Hash]) -> [Hash] -> Transaction [Hash]
forall a b. (a -> b) -> a -> b
$
[Hash
h | Reference.Derived Hash
h ConstructorId
_i <- [Reference]
declDependencies]
let missing' :: Set Hash
missing' = Set Hash
missing Set Hash -> Set Hash -> Set Hash
forall a. Semigroup a => a -> a -> a
<> [Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList [Hash]
moreMissing
IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO do
(Hash -> IO ()) -> [Hash] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Hash -> TVar (Map Hash DeclBufferEntry) -> Hash -> IO ()
forall a. Hash -> TVar (Map Hash (BufferEntry a)) -> Hash -> IO ()
addBufferDependent Hash
h TVar (Map Hash DeclBufferEntry)
declBuffer) [Hash]
moreMissing
TVar (Map Hash DeclBufferEntry) -> Hash -> DeclBufferEntry -> IO ()
forall a.
TVar (Map Hash (BufferEntry a)) -> Hash -> BufferEntry a -> IO ()
putBuffer TVar (Map Hash DeclBufferEntry)
declBuffer Hash
h (Maybe ConstructorId
-> Map ConstructorId (Decl Symbol Ann)
-> Set Hash
-> Set Hash
-> DeclBufferEntry
forall a.
Maybe ConstructorId
-> Map ConstructorId a -> Set Hash -> Set Hash -> BufferEntry a
BufferEntry Maybe ConstructorId
size' Map ConstructorId (Decl Symbol Ann)
comp' Set Hash
missing' Set Hash
waiting)
tryFlushDeclBuffer ::
TVar (Map Hash TermBufferEntry) ->
TVar (Map Hash DeclBufferEntry) ->
Hash ->
Transaction ()
tryFlushDeclBuffer :: TVar (Map Hash TermBufferEntry)
-> TVar (Map Hash DeclBufferEntry) -> Hash -> Transaction ()
tryFlushDeclBuffer TVar (Map Hash TermBufferEntry)
termBuffer TVar (Map Hash DeclBufferEntry)
declBuffer =
let loop :: Hash -> Transaction ()
loop Hash
h =
TVar (Map Hash DeclBufferEntry)
-> (Hash -> [Decl Symbol Ann] -> Transaction ())
-> (Hash -> Transaction ())
-> Hash
-> Transaction ()
forall a.
Show a =>
TVar (Map Hash (BufferEntry a))
-> (Hash -> [a] -> Transaction ())
-> (Hash -> Transaction ())
-> Hash
-> Transaction ()
tryFlushBuffer
TVar (Map Hash DeclBufferEntry)
declBuffer
( \Hash
h2 [Decl Symbol Ann]
component ->
Transaction ObjectId -> Transaction ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Transaction ObjectId -> Transaction ())
-> Transaction ObjectId -> Transaction ()
forall a b. (a -> b) -> a -> b
$
HashHandle
-> Maybe ByteString
-> Hash
-> [Decl Symbol]
-> Transaction ObjectId
Q.saveDeclComponent
HashHandle
v2HashHandle
Maybe ByteString
forall a. Maybe a
Nothing
Hash
h2
((Decl Symbol Ann -> Decl Symbol)
-> [Decl Symbol Ann] -> [Decl Symbol]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Hash -> Decl Symbol Ann -> Decl Symbol
forall a. Hash -> Decl Symbol a -> Decl Symbol
Cv.decl1to2 Hash
h) [Decl Symbol Ann]
component)
)
(\Hash
h -> TVar (Map Hash TermBufferEntry) -> Hash -> Transaction ()
tryFlushTermBuffer TVar (Map Hash TermBufferEntry)
termBuffer Hash
h Transaction () -> Transaction () -> Transaction ()
forall a b. Transaction a -> Transaction b -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Hash -> Transaction ()
loop Hash
h)
Hash
h
in Hash -> Transaction ()
loop
getBranchForHash ::
BranchCache Sqlite.Transaction ->
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
CausalHash ->
Transaction (Maybe (Branch Transaction))
getBranchForHash :: BranchCache Transaction
-> (Reference -> Transaction ConstructorType)
-> CausalHash
-> Transaction (Maybe (Branch Transaction))
getBranchForHash BranchCache Transaction
branchCache Reference -> Transaction ConstructorType
doGetDeclType CausalHash
h = do
CausalHash -> Transaction (Maybe (CausalBranch Transaction))
Ops.loadCausalBranchByCausalHash CausalHash
h Transaction (Maybe (CausalBranch Transaction))
-> (Maybe (CausalBranch Transaction)
-> Transaction (Maybe (Branch Transaction)))
-> Transaction (Maybe (Branch Transaction))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (CausalBranch Transaction)
Nothing -> Maybe (Branch Transaction)
-> Transaction (Maybe (Branch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Branch Transaction)
forall a. Maybe a
Nothing
Just CausalBranch Transaction
causal2 -> do
Branch Transaction
branch1 <- BranchCache Transaction
-> (Reference -> Transaction ConstructorType)
-> CausalBranch Transaction
-> Transaction (Branch Transaction)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (Branch m)
Cv.causalbranch2to1 BranchCache Transaction
branchCache Reference -> Transaction ConstructorType
doGetDeclType CausalBranch Transaction
causal2
pure (Branch Transaction -> Maybe (Branch Transaction)
forall a. a -> Maybe a
Just Branch Transaction
branch1)
putBranch :: Branch Transaction -> Transaction ()
putBranch :: Branch Transaction -> Transaction ()
putBranch =
Transaction (BranchObjectId, CausalHashId) -> Transaction ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Transaction (BranchObjectId, CausalHashId) -> Transaction ())
-> (Branch Transaction
-> Transaction (BranchObjectId, CausalHashId))
-> Branch Transaction
-> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashHandle
-> CausalBranch Transaction
-> Transaction (BranchObjectId, CausalHashId)
Ops.saveBranch HashHandle
v2HashHandle (CausalBranch Transaction
-> Transaction (BranchObjectId, CausalHashId))
-> (Branch Transaction -> CausalBranch Transaction)
-> Branch Transaction
-> Transaction (BranchObjectId, CausalHashId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch Transaction -> CausalBranch Transaction
forall (m :: * -> *). Monad m => Branch m -> CausalBranch m
Cv.causalbranch1to2
branchExists :: CausalHash -> Transaction Bool
branchExists :: CausalHash -> Transaction Bool
branchExists CausalHash
h =
Hash -> Transaction (Maybe HashId)
Q.loadHashIdByHash (CausalHash -> Hash
unCausalHash CausalHash
h) Transaction (Maybe HashId)
-> (Maybe HashId -> Transaction Bool) -> Transaction Bool
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe HashId
Nothing -> Bool -> Transaction Bool
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just HashId
hId -> HashId -> Transaction Bool
Q.isCausalHash HashId
hId
getPatch :: PatchHash -> Transaction (Maybe Patch)
getPatch :: PatchHash -> Transaction (Maybe Patch)
getPatch PatchHash
h =
MaybeT Transaction Patch -> Transaction (Maybe Patch)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
PatchObjectId
patchId <- Transaction (Maybe PatchObjectId)
-> MaybeT Transaction PatchObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (PatchHash -> Transaction (Maybe PatchObjectId)
Q.loadPatchObjectIdForPrimaryHash PatchHash
h)
Patch
patch <- Transaction Patch -> MaybeT Transaction Patch
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PatchObjectId -> Transaction Patch
Ops.expectPatch PatchObjectId
patchId)
pure (Patch -> Patch
Cv.patch2to1 Patch
patch)
putPatch :: PatchHash -> Patch -> Transaction ()
putPatch :: PatchHash -> Patch -> Transaction ()
putPatch PatchHash
h Patch
p =
Transaction PatchObjectId -> Transaction ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Transaction PatchObjectId -> Transaction ())
-> Transaction PatchObjectId -> Transaction ()
forall a b. (a -> b) -> a -> b
$ HashHandle -> PatchHash -> Patch -> Transaction PatchObjectId
Ops.savePatch HashHandle
v2HashHandle PatchHash
h (Patch -> Patch
Cv.patch1to2 Patch
p)
patchExists :: PatchHash -> Transaction Bool
patchExists :: PatchHash -> Transaction Bool
patchExists PatchHash
h = (Maybe PatchObjectId -> Bool)
-> Transaction (Maybe PatchObjectId) -> Transaction Bool
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe PatchObjectId -> Bool
forall a. Maybe a -> Bool
isJust (Transaction (Maybe PatchObjectId) -> Transaction Bool)
-> Transaction (Maybe PatchObjectId) -> Transaction Bool
forall a b. (a -> b) -> a -> b
$ PatchHash -> Transaction (Maybe PatchObjectId)
Q.loadPatchObjectIdForPrimaryHash PatchHash
h
dependentsImpl :: Q.DependentsSelector -> Reference -> Transaction (Set Reference.Id)
dependentsImpl :: DependentsSelector -> Reference -> Transaction (Set Id)
dependentsImpl DependentsSelector
selector Reference
r =
(Id -> Id) -> Set Id -> Set Id
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Id -> Id
Cv.referenceid2to1
(Set Id -> Set Id) -> Transaction (Set Id) -> Transaction (Set Id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DependentsSelector -> Reference -> Transaction (Set Id)
Ops.dependents DependentsSelector
selector (Reference -> Reference
Cv.reference1to2 Reference
r)
dependentsOfComponentImpl :: Hash -> Transaction (Set Reference.Id)
dependentsOfComponentImpl :: Hash -> Transaction (Set Id)
dependentsOfComponentImpl Hash
h =
(Id -> Id) -> Set Id -> Set Id
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Id -> Id
Cv.referenceid2to1 (Set Id -> Set Id) -> Transaction (Set Id) -> Transaction (Set Id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hash -> Transaction (Set Id)
Ops.dependentsOfComponent Hash
h
watches :: UF.WatchKind -> Transaction [Reference.Id]
watches :: WatchKind -> Transaction [Id]
watches WatchKind
w =
WatchKind -> Transaction [Id]
Ops.listWatches (WatchKind -> WatchKind
Cv.watchKind1to2 WatchKind
w) Transaction [Id] -> ([Id] -> [Id]) -> Transaction [Id]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Id
Cv.referenceid2to1
getWatch ::
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
UF.WatchKind ->
Reference.Id ->
Transaction (Maybe (Term Symbol Ann))
getWatch :: (Reference -> Transaction ConstructorType)
-> WatchKind -> Id -> Transaction (Maybe (Term Symbol Ann))
getWatch Reference -> Transaction ConstructorType
doGetDeclType WatchKind
k r :: Id
r@(Reference.Id Hash
h ConstructorId
_i) =
if WatchKind -> [WatchKind] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem WatchKind
k [WatchKind]
standardWatchKinds
then MaybeT Transaction (Term Symbol Ann)
-> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
Term Symbol
watch <- WatchKind -> Id -> MaybeT Transaction (Term Symbol)
Ops.loadWatch (WatchKind -> WatchKind
Cv.watchKind1to2 WatchKind
k) (Id -> Id
Cv.referenceid1to2 Id
r)
Transaction (Term Symbol Ann)
-> MaybeT Transaction (Term Symbol Ann)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Hash
-> (Reference -> Transaction ConstructorType)
-> Term Symbol
-> Transaction (Term Symbol Ann)
forall (m :: * -> *).
Monad m =>
Hash
-> (Reference -> m ConstructorType)
-> Term Symbol
-> m (Term Symbol Ann)
Cv.term2to1 Hash
h Reference -> Transaction ConstructorType
doGetDeclType Term Symbol
watch)
else Maybe (Term Symbol Ann) -> Transaction (Maybe (Term Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Term Symbol Ann)
forall a. Maybe a
Nothing
putWatch :: UF.WatchKind -> Reference.Id -> Term Symbol Ann -> Transaction ()
putWatch :: WatchKind -> Id -> Term Symbol Ann -> Transaction ()
putWatch WatchKind
k r :: Id
r@(Reference.Id Hash
h ConstructorId
_i) Term Symbol Ann
tm =
Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WatchKind -> [WatchKind] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem WatchKind
k [WatchKind]
standardWatchKinds) do
WatchKind -> Id -> Term Symbol -> Transaction ()
Ops.saveWatch
(WatchKind -> WatchKind
Cv.watchKind1to2 WatchKind
k)
(Id -> Id
Cv.referenceid1to2 Id
r)
(Hash -> Term Symbol Ann -> Term Symbol
Cv.term1to2 Hash
h Term Symbol Ann
tm)
standardWatchKinds :: [UF.WatchKind]
standardWatchKinds :: [WatchKind]
standardWatchKinds = [WatchKind
forall a. (Eq a, IsString a) => a
UF.RegularWatch, WatchKind
forall a. (Eq a, IsString a) => a
UF.TestWatch]
termsOfTypeImpl ::
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
Reference ->
Transaction (Set Referent.Id)
termsOfTypeImpl :: (Reference -> Transaction ConstructorType)
-> Reference -> Transaction (Set Id)
termsOfTypeImpl Reference -> Transaction ConstructorType
doGetDeclType Reference
r =
Reference -> Transaction (Set Id)
Ops.termsHavingType (Reference -> Reference
Cv.reference1to2 Reference
r)
Transaction (Set Id)
-> (Set Id -> Transaction (Set Id)) -> Transaction (Set Id)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse ((Reference -> Transaction ConstructorType) -> Id -> Transaction Id
forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType) -> Id -> m Id
Cv.referentid2to1 Reference -> Transaction ConstructorType
doGetDeclType)
termsMentioningTypeImpl ::
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
Reference ->
Transaction (Set Referent.Id)
termsMentioningTypeImpl :: (Reference -> Transaction ConstructorType)
-> Reference -> Transaction (Set Id)
termsMentioningTypeImpl Reference -> Transaction ConstructorType
doGetDeclType Reference
r =
Reference -> Transaction (Set Id)
Ops.termsMentioningType (Reference -> Reference
Cv.reference1to2 Reference
r)
Transaction (Set Id)
-> (Set Id -> Transaction (Set Id)) -> Transaction (Set Id)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse ((Reference -> Transaction ConstructorType) -> Id -> Transaction Id
forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType) -> Id -> m Id
Cv.referentid2to1 Reference -> Transaction ConstructorType
doGetDeclType)
filterReferencesHavingTypeImpl :: Reference -> Set Reference.Id -> Transaction (Set Reference.Id)
filterReferencesHavingTypeImpl :: Reference -> Set Id -> Transaction (Set Id)
filterReferencesHavingTypeImpl Reference
typRef Set Id
termRefs =
Reference -> [Id] -> Transaction [Id]
Ops.filterTermsByReferenceHavingType (Reference -> Reference
Cv.reference1to2 Reference
typRef) (Id -> Id
Cv.referenceid1to2 (Id -> Id) -> [Id] -> [Id]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Id -> [Id]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Id
termRefs)
Transaction [Id] -> ([Id] -> [Id]) -> Transaction [Id]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Id
Cv.referenceid2to1
Transaction [Id] -> ([Id] -> Set Id) -> Transaction (Set Id)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList
filterReferentsHavingTypeImpl ::
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
Reference ->
Set Referent.Id ->
Transaction (Set Referent.Id)
filterReferentsHavingTypeImpl :: (Reference -> Transaction ConstructorType)
-> Reference -> Set Id -> Transaction (Set Id)
filterReferentsHavingTypeImpl Reference -> Transaction ConstructorType
doGetDeclType Reference
typRef Set Id
termRefs =
Reference -> [Id] -> Transaction [Id]
Ops.filterTermsByReferentHavingType (Reference -> Reference
Cv.reference1to2 Reference
typRef) (Id -> Id
Cv.referentid1to2 (Id -> Id) -> [Id] -> [Id]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Id -> [Id]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Id
termRefs)
Transaction [Id] -> ([Id] -> Transaction [Id]) -> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Reference -> Transaction ConstructorType) -> Id -> Transaction Id
forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType) -> Id -> m Id
Cv.referentid2to1 Reference -> Transaction ConstructorType
doGetDeclType)
Transaction [Id] -> ([Id] -> Set Id) -> Transaction (Set Id)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList
hashLength :: Transaction Int
hashLength :: Transaction Int
hashLength = Int -> Transaction Int
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
10
branchHashLength :: Transaction Int
branchHashLength :: Transaction Int
branchHashLength = Int -> Transaction Int
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
10
defnReferencesByPrefix :: OT.ObjectType -> ShortHash -> Transaction (Set Reference.Id)
defnReferencesByPrefix :: ObjectType -> ShortHash -> Transaction (Set Id)
defnReferencesByPrefix ObjectType
_ (ShortHash.Builtin Text
_) = Set Id -> Transaction (Set Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Id
forall a. Monoid a => a
mempty
defnReferencesByPrefix ObjectType
ot (ShortHash.ShortHash Text
prefix Maybe ConstructorId
cycle Maybe ConstructorId
_cid) = do
Set Id
refs <- do
ObjectType
-> Text -> Maybe ConstructorId -> Transaction [Id' ObjectId]
Ops.componentReferencesByPrefix ObjectType
ot Text
prefix Maybe ConstructorId
cycle
Transaction [Id' ObjectId]
-> ([Id' ObjectId] -> Transaction [Id]) -> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id' ObjectId -> Transaction Id)
-> [Id' ObjectId] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((ObjectId -> Transaction Hash) -> Id' ObjectId -> Transaction Id
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId)
Transaction [Id]
-> ([Id] -> Transaction (Set Id)) -> Transaction (Set Id)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Set Id -> Transaction (Set Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Id -> Transaction (Set Id))
-> ([Id] -> Set Id) -> [Id] -> Transaction (Set Id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList
pure $ (Id -> Id) -> Set Id -> Set Id
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Id -> Id
Cv.referenceid2to1 Set Id
refs
termReferencesByPrefix :: ShortHash -> Transaction (Set Reference.Id)
termReferencesByPrefix :: ShortHash -> Transaction (Set Id)
termReferencesByPrefix = ObjectType -> ShortHash -> Transaction (Set Id)
defnReferencesByPrefix ObjectType
OT.TermComponent
typeReferencesByPrefix :: ShortHash -> Transaction (Set Reference.Id)
typeReferencesByPrefix :: ShortHash -> Transaction (Set Id)
typeReferencesByPrefix = ObjectType -> ShortHash -> Transaction (Set Id)
defnReferencesByPrefix ObjectType
OT.DeclComponent
referentsByPrefix ::
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
ShortHash ->
Transaction (Set Referent.Id)
referentsByPrefix :: (Reference -> Transaction ConstructorType)
-> ShortHash -> Transaction (Set Id)
referentsByPrefix Reference -> Transaction ConstructorType
_doGetDeclType ShortHash.Builtin {} = Set Id -> Transaction (Set Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Id
forall a. Monoid a => a
mempty
referentsByPrefix Reference -> Transaction ConstructorType
doGetDeclType (ShortHash.ShortHash Text
prefix Maybe ConstructorId
cycle Maybe ConstructorId
cid) = do
[Id]
termReferents <-
Text -> Maybe ConstructorId -> Transaction [Id]
Ops.termReferentsByPrefix Text
prefix Maybe ConstructorId
cycle
Transaction [Id] -> ([Id] -> Transaction [Id]) -> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Reference -> Transaction ConstructorType) -> Id -> Transaction Id
forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType) -> Id -> m Id
Cv.referentid2to1 Reference -> Transaction ConstructorType
doGetDeclType)
[(Hash, ConstructorId, DeclType, [ConstructorId])]
declReferents' <- Text
-> Maybe ConstructorId
-> Maybe ConstructorId
-> Transaction [(Hash, ConstructorId, DeclType, [ConstructorId])]
Ops.declReferentsByPrefix Text
prefix Maybe ConstructorId
cycle Maybe ConstructorId
cid
let declReferents :: [Id]
declReferents =
[ ConstructorReferenceId -> ConstructorType -> Id
Referent.ConId (Id -> ConstructorId -> ConstructorReferenceId
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference (Hash -> ConstructorId -> Id
forall h. h -> ConstructorId -> Id' h
Reference.Id Hash
h ConstructorId
pos) (ConstructorId -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
cid)) (DeclType -> ConstructorType
Cv.decltype2to1 DeclType
ct)
| (Hash
h, ConstructorId
pos, DeclType
ct, [ConstructorId]
cids) <- [(Hash, ConstructorId, DeclType, [ConstructorId])]
declReferents',
ConstructorId
cid <- [ConstructorId]
cids
]
Set Id -> Transaction (Set Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Id -> Transaction (Set Id))
-> ([Id] -> Set Id) -> [Id] -> Transaction (Set Id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList ([Id] -> Transaction (Set Id)) -> [Id] -> Transaction (Set Id)
forall a b. (a -> b) -> a -> b
$ [Id]
termReferents [Id] -> [Id] -> [Id]
forall a. Semigroup a => a -> a -> a
<> [Id]
declReferents
causalHashesByPrefix :: ShortCausalHash -> Transaction (Set CausalHash)
causalHashesByPrefix :: ShortCausalHash -> Transaction (Set CausalHash)
causalHashesByPrefix ShortCausalHash
sh = do
ShortCausalHash -> Transaction (Set CausalHash)
Ops.causalHashesByPrefix (ShortCausalHash -> ShortCausalHash
Cv.sch1to2 ShortCausalHash
sh)
termExists, declExists :: Hash -> Transaction Bool
termExists :: Hash -> Transaction Bool
termExists = (Maybe ObjectId -> Bool)
-> Transaction (Maybe ObjectId) -> Transaction Bool
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ObjectId -> Bool
forall a. Maybe a -> Bool
isJust (Transaction (Maybe ObjectId) -> Transaction Bool)
-> (Hash -> Transaction (Maybe ObjectId))
-> Hash
-> Transaction Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForPrimaryHash
declExists :: Hash -> Transaction Bool
declExists = Hash -> Transaction Bool
termExists
before :: CausalHash -> CausalHash -> Transaction Bool
before :: CausalHash -> CausalHash -> Transaction Bool
before CausalHash
h1 CausalHash
h2 =
Maybe Bool -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Bool -> Bool)
-> Transaction (Maybe Bool) -> Transaction Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CausalHash -> CausalHash -> Transaction (Maybe Bool)
Ops.before CausalHash
h1 CausalHash
h2
makeCachedTransaction :: (Ord a) => Cache.Cache a b -> (a -> Sqlite.Transaction b) -> a -> Sqlite.Transaction b
makeCachedTransaction :: forall a b.
Ord a =>
Cache a b -> (a -> Transaction b) -> a -> Transaction b
makeCachedTransaction Cache a b
cache a -> Transaction b
action a
x = do
Connection
conn <- Transaction Connection
Sqlite.unsafeGetConnection
IO b -> Transaction b
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (Cache a b -> (a -> IO b) -> a -> IO b
forall (m :: * -> *) k v.
MonadIO m =>
Cache k v -> (k -> m v) -> k -> m v
Cache.apply Cache a b
cache (\a
x -> Transaction b -> Connection -> IO b
forall a. Transaction a -> Connection -> IO a
Sqlite.unsafeUnTransaction (a -> Transaction b
action a
x) Connection
conn) a
x)
makeMaybeCachedTransaction ::
(Ord a) =>
Cache.Cache a b ->
(a -> Sqlite.Transaction (Maybe b)) ->
a ->
Sqlite.Transaction (Maybe b)
makeMaybeCachedTransaction :: forall a b.
Ord a =>
Cache a b
-> (a -> Transaction (Maybe b)) -> a -> Transaction (Maybe b)
makeMaybeCachedTransaction Cache a b
cache a -> Transaction (Maybe b)
action a
x = do
Connection
conn <- Transaction Connection
Sqlite.unsafeGetConnection
IO (Maybe b) -> Transaction (Maybe b)
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (Cache a b -> (a -> IO (Maybe b)) -> a -> IO (Maybe b)
forall (m :: * -> *) (g :: * -> *) k v.
(MonadIO m, Applicative g, Traversable g) =>
Cache k v -> (k -> m (g v)) -> k -> m (g v)
Cache.applyDefined Cache a b
cache (\a
x -> Transaction (Maybe b) -> Connection -> IO (Maybe b)
forall a. Transaction a -> Connection -> IO a
Sqlite.unsafeUnTransaction (a -> Transaction (Maybe b)
action a
x) Connection
conn) a
x)
insertProjectAndBranch ::
ProjectName ->
ProjectBranchName ->
Db.CausalHashId ->
Sqlite.Transaction (Project, ProjectBranchRow)
insertProjectAndBranch :: ProjectName
-> ProjectBranchName
-> CausalHashId
-> Transaction (Project, ProjectBranchRow)
insertProjectAndBranch ProjectName
projectName ProjectBranchName
branchName CausalHashId
chId = do
ProjectId
projectId <- Transaction (Maybe ProjectId)
-> Transaction ProjectId -> Transaction ProjectId
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
whenNothingM ((Project -> ProjectId) -> Maybe Project -> Maybe ProjectId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Project -> ProjectId
Project.projectId (Maybe Project -> Maybe ProjectId)
-> Transaction (Maybe Project) -> Transaction (Maybe ProjectId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectName -> Transaction (Maybe Project)
Q.loadProjectByName ProjectName
projectName) do
ProjectId
projectId <- IO ProjectId -> Transaction ProjectId
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (UUID -> ProjectId
Db.ProjectId (UUID -> ProjectId) -> IO UUID -> IO ProjectId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom)
ProjectId -> ProjectName -> Transaction ()
Q.insertProject ProjectId
projectId ProjectName
projectName
pure ProjectId
projectId
ProjectBranchId
branchId <- IO ProjectBranchId -> Transaction ProjectBranchId
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (UUID -> ProjectBranchId
Db.ProjectBranchId (UUID -> ProjectBranchId) -> IO UUID -> IO ProjectBranchId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom)
let projectBranch :: ProjectBranchRow
projectBranch =
ProjectBranchRow
{ ProjectId
$sel:projectId:ProjectBranchRow :: ProjectId
projectId :: ProjectId
projectId,
ProjectBranchId
$sel:branchId:ProjectBranchRow :: ProjectBranchId
branchId :: ProjectBranchId
branchId,
$sel:name:ProjectBranchRow :: ProjectBranchName
name = ProjectBranchName
branchName,
$sel:parentBranchId:ProjectBranchRow :: Maybe ProjectBranchId
parentBranchId = Maybe ProjectBranchId
forall a. Maybe a
Nothing
}
HasCallStack =>
Text -> CausalHashId -> ProjectBranchRow -> Transaction ()
Text -> CausalHashId -> ProjectBranchRow -> Transaction ()
Q.insertProjectBranch
Text
"Project Created"
CausalHashId
chId
ProjectBranchRow
projectBranch
ProjectId -> ProjectBranchId -> Transaction ()
Q.setMostRecentBranch ProjectId
projectId ProjectBranchId
branchId
pure
( Project {$sel:name:Project :: ProjectName
name = ProjectName
projectName, ProjectId
projectId :: ProjectId
$sel:projectId:Project :: ProjectId
projectId},
ProjectBranchRow {ProjectId
$sel:projectId:ProjectBranchRow :: ProjectId
projectId :: ProjectId
projectId, $sel:name:ProjectBranchRow :: ProjectBranchName
name = ProjectBranchName
branchName, ProjectBranchId
$sel:branchId:ProjectBranchRow :: ProjectBranchId
branchId :: ProjectBranchId
branchId, $sel:parentBranchId:ProjectBranchRow :: Maybe ProjectBranchId
parentBranchId = Maybe ProjectBranchId
forall a. Maybe a
Nothing}
)
emptyCausalHash :: Sqlite.Transaction (CausalHash, Db.CausalHashId)
emptyCausalHash :: Transaction (CausalHash, CausalHashId)
emptyCausalHash = do
let emptyBranch :: Branch m
emptyBranch = Branch m
forall (m :: * -> *). Branch m
Branch.empty
Branch Transaction -> Transaction ()
putBranch Branch Transaction
forall (m :: * -> *). Branch m
emptyBranch
let causalHash :: CausalHash
causalHash = Branch Any -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch Any
forall (m :: * -> *). Branch m
emptyBranch
CausalHashId
causalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
causalHash
pure (CausalHash
causalHash, CausalHashId
causalHashId)