mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-10 11:15:08 +03:00
move sqlite decoders into their own module
This commit is contained in:
Mitchell Rosen
parent
e84d4fa1aa
commit
3061ea9367
129
codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs
Normal file
129
codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs
Normal file
@ -0,0 +1,129 @@
|
||||
-- | This module contains decoders for blobs stored in SQLite.
|
||||
module U.Codebase.Sqlite.Decode
|
||||
( DecodeError,
|
||||
|
||||
-- * @object.bytes@
|
||||
decodeBranchFormat,
|
||||
decodeComponentLengthOnly,
|
||||
decodeDeclElement,
|
||||
decodeDeclFormat,
|
||||
decodePatchFormat,
|
||||
decodeTermFormat,
|
||||
decodeTermElementDiscardingTerm,
|
||||
decodeTermElementDiscardingType,
|
||||
decodeTermElementWithType,
|
||||
|
||||
-- * @temp_entity.blob@
|
||||
decodeTempCausalFormat,
|
||||
decodeTempDeclFormat,
|
||||
decodeTempNamespaceFormat,
|
||||
decodeTempPatchFormat,
|
||||
decodeTempTermFormat,
|
||||
|
||||
-- * @watch_result.result@
|
||||
decodeWatchResultFormat,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Bytes.Get (runGetS)
|
||||
import qualified Data.Bytes.Get as Get
|
||||
import qualified U.Codebase.Reference as C.Reference
|
||||
import qualified U.Codebase.Sqlite.Branch.Format as NamespaceFormat
|
||||
import qualified U.Codebase.Sqlite.Decl.Format as DeclFormat
|
||||
import U.Codebase.Sqlite.LocalIds (LocalIds)
|
||||
import qualified U.Codebase.Sqlite.Patch.Format as PatchFormat
|
||||
import U.Codebase.Sqlite.Serialization as Serialization
|
||||
import U.Codebase.Sqlite.Symbol (Symbol)
|
||||
import qualified U.Codebase.Sqlite.TempEntity as TempEntity
|
||||
import qualified U.Codebase.Sqlite.Term.Format as TermFormat
|
||||
import U.Util.Serialization (Get)
|
||||
import qualified U.Util.Serialization as Serialization (lengthFramedArray)
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Decode error
|
||||
|
||||
data DecodeError = DecodeError
|
||||
{ decoder :: Text, -- the name of the decoder
|
||||
err :: String -- the error message
|
||||
}
|
||||
deriving stock (Show)
|
||||
deriving anyclass (SqliteExceptionReason)
|
||||
|
||||
getFromBytesOr :: Text -> Get a -> ByteString -> Either DecodeError a
|
||||
getFromBytesOr decoder get bs = case runGetS get bs of
|
||||
Left err -> Left (DecodeError decoder err)
|
||||
Right a -> Right a
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- object.bytes
|
||||
|
||||
decodeBranchFormat :: ByteString -> Either DecodeError NamespaceFormat.BranchFormat
|
||||
decodeBranchFormat =
|
||||
getFromBytesOr "getBranchFormat" Serialization.getBranchFormat
|
||||
|
||||
decodeComponentLengthOnly :: ByteString -> Either DecodeError Word64
|
||||
decodeComponentLengthOnly =
|
||||
getFromBytesOr "lengthFramedArray" (Get.skip 1 >> Serialization.lengthFramedArray)
|
||||
|
||||
decodeDeclElement :: Word64 -> ByteString -> Either DecodeError (LocalIds, DeclFormat.Decl Symbol)
|
||||
decodeDeclElement i =
|
||||
getFromBytesOr ("lookupDeclElement " <> tShow i) (Serialization.lookupDeclElement i)
|
||||
|
||||
decodeDeclFormat :: ByteString -> Either DecodeError DeclFormat.DeclFormat
|
||||
decodeDeclFormat =
|
||||
getFromBytesOr "getDeclFormat" Serialization.getDeclFormat
|
||||
|
||||
decodePatchFormat :: ByteString -> Either DecodeError PatchFormat.PatchFormat
|
||||
decodePatchFormat =
|
||||
getFromBytesOr "getPatchFormat" Serialization.getPatchFormat
|
||||
|
||||
decodeTermFormat :: ByteString -> Either DecodeError TermFormat.TermFormat
|
||||
decodeTermFormat =
|
||||
getFromBytesOr "getTermFormat" Serialization.getTermFormat
|
||||
|
||||
decodeTermElementDiscardingTerm :: C.Reference.Pos -> ByteString -> Either DecodeError (LocalIds, TermFormat.Type)
|
||||
decodeTermElementDiscardingTerm i =
|
||||
getFromBytesOr ("lookupTermElementDiscardingTerm " <> tShow i) (Serialization.lookupTermElementDiscardingTerm i)
|
||||
|
||||
decodeTermElementDiscardingType :: C.Reference.Pos -> ByteString -> Either DecodeError (LocalIds, TermFormat.Term)
|
||||
decodeTermElementDiscardingType i =
|
||||
getFromBytesOr ("lookupTermElementDiscardingType " <> tShow i) (Serialization.lookupTermElementDiscardingType i)
|
||||
|
||||
decodeTermElementWithType ::
|
||||
C.Reference.Pos ->
|
||||
ByteString ->
|
||||
Either DecodeError (LocalIds, TermFormat.Term, TermFormat.Type)
|
||||
decodeTermElementWithType i =
|
||||
getFromBytesOr ("lookupTermElement" <> tShow i) (Serialization.lookupTermElement i)
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- temp_entity.blob
|
||||
|
||||
decodeTempCausalFormat :: ByteString -> Either DecodeError TempEntity.TempCausalFormat
|
||||
decodeTempCausalFormat =
|
||||
getFromBytesOr "getTempCausalFormat" Serialization.getTempCausalFormat
|
||||
|
||||
decodeTempDeclFormat :: ByteString -> Either DecodeError TempEntity.TempDeclFormat
|
||||
decodeTempDeclFormat =
|
||||
getFromBytesOr "getTempDeclFormat" Serialization.getTempDeclFormat
|
||||
|
||||
decodeTempNamespaceFormat :: ByteString -> Either DecodeError TempEntity.TempNamespaceFormat
|
||||
decodeTempNamespaceFormat =
|
||||
getFromBytesOr "getTempNamespaceFormat" Serialization.getTempNamespaceFormat
|
||||
|
||||
decodeTempPatchFormat :: ByteString -> Either DecodeError TempEntity.TempPatchFormat
|
||||
decodeTempPatchFormat =
|
||||
getFromBytesOr "getTempPatchFormat" Serialization.getTempPatchFormat
|
||||
|
||||
decodeTempTermFormat :: ByteString -> Either DecodeError TempEntity.TempTermFormat
|
||||
decodeTempTermFormat =
|
||||
getFromBytesOr "getTempTermFormat" Serialization.getTempTermFormat
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- watch_result.result
|
||||
|
||||
decodeWatchResultFormat :: ByteString -> Either DecodeError TermFormat.WatchResultFormat
|
||||
decodeWatchResultFormat =
|
||||
getFromBytesOr "getWatchResultFormat" Serialization.getWatchResultFormat
|
||||
@ -86,7 +86,6 @@ import Control.Monad.Writer (MonadWriter, runWriterT)
|
||||
import qualified Control.Monad.Writer as Writer
|
||||
import Data.Bifunctor (Bifunctor (bimap))
|
||||
import Data.Bitraversable (Bitraversable (bitraverse))
|
||||
import qualified Data.Bytes.Get as Get
|
||||
import qualified Data.Foldable as Foldable
|
||||
import Data.Functor.Identity (Identity)
|
||||
import qualified Data.Map as Map
|
||||
@ -118,6 +117,7 @@ import qualified U.Codebase.Sqlite.Branch.Full as S.Branch.Full
|
||||
import qualified U.Codebase.Sqlite.Branch.Full as S.MetadataSet
|
||||
import qualified U.Codebase.Sqlite.DbId as Db
|
||||
import qualified U.Codebase.Sqlite.Decl.Format as S.Decl
|
||||
import U.Codebase.Sqlite.Decode
|
||||
import U.Codebase.Sqlite.LocalIds
|
||||
( LocalDefnId (..),
|
||||
LocalIds,
|
||||
@ -305,37 +305,6 @@ diffPatch (S.Patch fullTerms fullTypes) (S.Patch refTerms refTypes) =
|
||||
addDiffSet = Map.zipWithMatched (const Set.difference)
|
||||
removeDiffSet = Map.zipWithMatched (const (flip Set.difference))
|
||||
|
||||
-- * Deserialization helpers
|
||||
|
||||
decodeBranchFormat :: ByteString -> Either Q.DecodeError S.BranchFormat.BranchFormat
|
||||
decodeBranchFormat = Q.getFromBytesOr "getBranchFormat" S.getBranchFormat
|
||||
|
||||
decodePatchFormat :: ByteString -> Either Q.DecodeError S.Patch.Format.PatchFormat
|
||||
decodePatchFormat = Q.getFromBytesOr "getPatchFormat" S.getPatchFormat
|
||||
|
||||
decodeTermFormat :: ByteString -> Either Q.DecodeError S.Term.TermFormat
|
||||
decodeTermFormat = Q.getFromBytesOr "getTermFormat" S.getTermFormat
|
||||
|
||||
decodeComponentLengthOnly :: ByteString -> Either Q.DecodeError Word64
|
||||
decodeComponentLengthOnly = Q.getFromBytesOr "lengthFramedArray" (Get.skip 1 >> S.lengthFramedArray)
|
||||
|
||||
decodeTermElementWithType :: C.Reference.Pos -> ByteString -> Either Q.DecodeError (LocalIds, S.Term.Term, S.Term.Type)
|
||||
decodeTermElementWithType i = Q.getFromBytesOr ("lookupTermElement" <> tShow i) (S.lookupTermElement i)
|
||||
|
||||
decodeTermElementDiscardingTerm :: C.Reference.Pos -> ByteString -> Either Q.DecodeError (LocalIds, S.Term.Type)
|
||||
decodeTermElementDiscardingTerm i =
|
||||
Q.getFromBytesOr ("lookupTermElementDiscardingTerm " <> tShow i) (S.lookupTermElementDiscardingTerm i)
|
||||
|
||||
decodeTermElementDiscardingType :: C.Reference.Pos -> ByteString -> Either Q.DecodeError (LocalIds, S.Term.Term)
|
||||
decodeTermElementDiscardingType i =
|
||||
Q.getFromBytesOr ("lookupTermElementDiscardingType " <> tShow i) (S.lookupTermElementDiscardingType i)
|
||||
|
||||
decodeDeclFormat :: ByteString -> Either Q.DecodeError S.Decl.DeclFormat
|
||||
decodeDeclFormat = Q.getFromBytesOr "getDeclFormat" S.getDeclFormat
|
||||
|
||||
decodeDeclElement :: Word64 -> ByteString -> Either Q.DecodeError (LocalIds, S.Decl.Decl Symbol)
|
||||
decodeDeclElement i = Q.getFromBytesOr ("lookupDeclElement " <> tShow i) (S.lookupDeclElement i)
|
||||
|
||||
getCycleLen :: H.Hash -> Transaction (Maybe Word64)
|
||||
getCycleLen h = do
|
||||
when debug $ traceM $ "\ngetCycleLen " ++ (Text.unpack . Base32Hex.toText $ H.toBase32Hex h)
|
||||
@ -641,7 +610,7 @@ listWatches k = Q.loadWatchesByWatchKind k >>= traverse h2cReferenceId
|
||||
loadWatch :: WatchKind -> C.Reference.Id -> MaybeT Transaction (C.Term Symbol)
|
||||
loadWatch k r = do
|
||||
r' <- C.Reference.idH (lift . Q.saveHashHash) r
|
||||
S.Term.WatchResult wlids t <- MaybeT (Q.loadWatch k r' (Q.getFromBytesOr "getWatchResultFormat" S.getWatchResultFormat))
|
||||
S.Term.WatchResult wlids t <- MaybeT (Q.loadWatch k r' decodeWatchResultFormat)
|
||||
lift (w2cTerm wlids t)
|
||||
|
||||
saveWatch :: WatchKind -> C.Reference.Id -> C.Term Symbol -> Transaction ()
|
||||
|
||||
@ -137,16 +137,11 @@ module U.Codebase.Sqlite.Queries
|
||||
schemaVersion,
|
||||
expectSchemaVersion,
|
||||
setSchemaVersion,
|
||||
|
||||
-- * errors
|
||||
DecodeError,
|
||||
getFromBytesOr,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Control.Lens as Lens
|
||||
import Data.Bitraversable (bitraverse)
|
||||
import Data.Bytes.Get (runGetS)
|
||||
import Data.Bytes.Put (runPutS)
|
||||
import qualified Data.Foldable as Foldable
|
||||
import qualified Data.List.Extra as List
|
||||
@ -176,6 +171,7 @@ import U.Codebase.Sqlite.DbId
|
||||
TextId,
|
||||
)
|
||||
import qualified U.Codebase.Sqlite.Decl.Format as DeclFormat
|
||||
import U.Codebase.Sqlite.Decode
|
||||
import U.Codebase.Sqlite.Entity (SyncEntity)
|
||||
import qualified U.Codebase.Sqlite.Entity as Entity
|
||||
import U.Codebase.Sqlite.ObjectType (ObjectType (DeclComponent, Namespace, Patch, TermComponent))
|
||||
@ -195,7 +191,6 @@ import qualified U.Util.Alternative as Alternative
|
||||
import U.Util.Base32Hex (Base32Hex (..))
|
||||
import U.Util.Hash (Hash)
|
||||
import qualified U.Util.Hash as Hash
|
||||
import U.Util.Serialization (Get)
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite
|
||||
|
||||
@ -652,20 +647,16 @@ moveTempEntityToMain b32 = do
|
||||
_ <- saveSyncEntity b32 r
|
||||
pure ()
|
||||
|
||||
-- | Read an entity out of temp storage.
|
||||
expectTempEntity :: Base32Hex -> Transaction TempEntity
|
||||
expectTempEntity b32 = do
|
||||
queryOneRowCheck sql (Only b32) \(blob, typeId) ->
|
||||
case typeId of
|
||||
TempEntityType.TermComponentType ->
|
||||
Entity.TC <$> getFromBytesOr "getTempTermFormat" Serialization.getTempTermFormat blob
|
||||
TempEntityType.DeclComponentType ->
|
||||
Entity.DC <$> getFromBytesOr "getTempDeclFormat" Serialization.getTempDeclFormat blob
|
||||
TempEntityType.NamespaceType ->
|
||||
Entity.N <$> getFromBytesOr "getTempNamespaceFormat" Serialization.getTempNamespaceFormat blob
|
||||
TempEntityType.PatchType ->
|
||||
Entity.P <$> getFromBytesOr "getTempPatchFormat" Serialization.getTempPatchFormat blob
|
||||
TempEntityType.CausalType ->
|
||||
Entity.C <$> getFromBytesOr "getTempCausalFormat" Serialization.getTempCausalFormat blob
|
||||
TempEntityType.TermComponentType -> Entity.TC <$> decodeTempTermFormat blob
|
||||
TempEntityType.DeclComponentType -> Entity.DC <$> decodeTempDeclFormat blob
|
||||
TempEntityType.NamespaceType -> Entity.N <$> decodeTempNamespaceFormat blob
|
||||
TempEntityType.PatchType -> Entity.P <$> decodeTempPatchFormat blob
|
||||
TempEntityType.CausalType -> Entity.C <$> decodeTempCausalFormat blob
|
||||
where sql = [here|
|
||||
SELECT (blob, type_id)
|
||||
FROM temp_entity
|
||||
@ -1299,20 +1290,6 @@ deleteTempDependencies dependent (Foldable.toList -> dependencies) =
|
||||
AND dependency = ?
|
||||
|]
|
||||
|
||||
-- * errors
|
||||
|
||||
data DecodeError = DecodeError
|
||||
{ decoder :: Text, -- the name of the decoder
|
||||
err :: String -- the error message
|
||||
}
|
||||
deriving stock (Show)
|
||||
deriving anyclass (SqliteExceptionReason)
|
||||
|
||||
getFromBytesOr :: Text -> Get a -> ByteString -> Either DecodeError a
|
||||
getFromBytesOr decoder get bs = case runGetS get bs of
|
||||
Left err -> Left (DecodeError decoder err)
|
||||
Right a -> Right a
|
||||
|
||||
-- * orphan instances
|
||||
|
||||
deriving via Text instance ToField Base32Hex
|
||||
|
||||
@ -25,6 +25,7 @@ library
|
||||
U.Codebase.Sqlite.Causal
|
||||
U.Codebase.Sqlite.DbId
|
||||
U.Codebase.Sqlite.Decl.Format
|
||||
U.Codebase.Sqlite.Decode
|
||||
U.Codebase.Sqlite.Entity
|
||||
U.Codebase.Sqlite.LocalIds
|
||||
U.Codebase.Sqlite.LocalizeObject
|
||||
|
||||
Loading…
Reference in New Issue
Block a user