-- | This module contains decoders for blobs stored in SQLite.
module U.Codebase.Sqlite.Decode
  ( DecodeError (..),

    -- * @object.bytes@
    decodeBranchFormat,
    decodeComponentLengthOnly,
    decodeDeclElement,
    decodeDeclElementNumConstructors,
    decodeDeclFormat,
    decodePatchFormat,
    decodeSyncDeclFormat,
    decodeSyncNamespaceFormat,
    decodeSyncPatchFormat,
    decodeSyncTermFormat,
    decodeSyncTermAndType,
    decodeTermElementDiscardingTerm,
    decodeTermElementDiscardingType,
    decodeTermElementWithType,
    decodeTermFormat,

    -- * @temp_entity.blob@
    decodeTempCausalFormat,
    decodeTempDeclFormat,
    decodeTempNamespaceFormat,
    decodeTempPatchFormat,
    decodeTempTermFormat,

    -- * @watch_result.result@
    decodeWatchResultFormat,

    -- * unsyncs
    unsyncTermComponent,
    unsyncDeclComponent,
  )
where

import Data.Bytes.Get (runGetS)
import Data.Bytes.Get qualified as Get
import U.Codebase.Reference qualified as C.Reference
import U.Codebase.Sqlite.Branch.Format qualified as NamespaceFormat
import U.Codebase.Sqlite.Decl.Format qualified as DeclFormat
import U.Codebase.Sqlite.LocalIds (LocalIds)
import U.Codebase.Sqlite.Patch.Format qualified as PatchFormat
import U.Codebase.Sqlite.Serialization as Serialization
import U.Codebase.Sqlite.Symbol (Symbol)
import U.Codebase.Sqlite.TempEntity qualified as TempEntity
import U.Codebase.Sqlite.Term.Format qualified as TermFormat
import U.Util.Serialization (Get)
import U.Util.Serialization qualified as Serialization (lengthFramedArray)
import Unison.Prelude
import Unison.Sqlite

------------------------------------------------------------------------------------------------------------------------
-- Decode error

data DecodeError = DecodeError
  { DecodeError -> Text
decoder :: Text, -- the name of the decoder
    DecodeError -> String
err :: String -- the error message
  }
  deriving stock (Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeError -> ShowS
showsPrec :: Int -> DecodeError -> ShowS
$cshow :: DecodeError -> String
show :: DecodeError -> String
$cshowList :: [DecodeError] -> ShowS
showList :: [DecodeError] -> ShowS
Show)
  deriving anyclass (Show DecodeError
Typeable DecodeError
(Show DecodeError, Typeable DecodeError) =>
SqliteExceptionReason DecodeError
forall e. (Show e, Typeable e) => SqliteExceptionReason e
SqliteExceptionReason, Show DecodeError
Typeable DecodeError
(Typeable DecodeError, Show DecodeError) =>
(DecodeError -> SomeException)
-> (SomeException -> Maybe DecodeError)
-> (DecodeError -> String)
-> Exception DecodeError
SomeException -> Maybe DecodeError
DecodeError -> String
DecodeError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: DecodeError -> SomeException
toException :: DecodeError -> SomeException
$cfromException :: SomeException -> Maybe DecodeError
fromException :: SomeException -> Maybe DecodeError
$cdisplayException :: DecodeError -> String
displayException :: DecodeError -> String
Exception)

getFromBytesOr :: Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr :: forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
decoder Get a
get ByteString
bs = case Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
Get a
get ByteString
bs of
  Left String
err -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (Text -> String -> DecodeError
DecodeError Text
decoder String
err)
  Right a
a -> a -> Either DecodeError a
forall a b. b -> Either a b
Right a
a

------------------------------------------------------------------------------------------------------------------------
-- object.bytes

decodeBranchFormat :: ByteString -> Either DecodeError NamespaceFormat.BranchFormat
decodeBranchFormat :: ByteString -> Either DecodeError BranchFormat
decodeBranchFormat =
  Text
-> Get BranchFormat
-> ByteString
-> Either DecodeError BranchFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getBranchFormat" m BranchFormat
Get BranchFormat
Serialization.getBranchFormat

decodeComponentLengthOnly :: ByteString -> Either DecodeError Word64
decodeComponentLengthOnly :: ByteString -> Either DecodeError Word64
decodeComponentLengthOnly =
  Text -> Get Word64 -> ByteString -> Either DecodeError Word64
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"lengthFramedArray" (Int -> m ()
forall (m :: * -> *). MonadGet m => Int -> m ()
Get.skip Int
1 m () -> m Word64 -> m Word64
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Word64
Get Word64
Serialization.lengthFramedArray)

decodeDeclElement :: Word64 -> ByteString -> Either DecodeError (LocalIds, DeclFormat.Decl Symbol)
decodeDeclElement :: Word64 -> ByteString -> Either DecodeError (LocalIds, Decl Symbol)
decodeDeclElement Word64
i =
  Text
-> Get (LocalIds, Decl Symbol)
-> ByteString
-> Either DecodeError (LocalIds, Decl Symbol)
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr (Text
"lookupDeclElement " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tShow Word64
i) (Word64 -> m (LocalIds, Decl Symbol)
forall (m :: * -> *).
MonadGet m =>
Word64 -> m (LocalIds, Decl Symbol)
Serialization.lookupDeclElement Word64
i)

decodeDeclElementNumConstructors :: Word64 -> ByteString -> Either DecodeError Int
decodeDeclElementNumConstructors :: Word64 -> ByteString -> Either DecodeError Int
decodeDeclElementNumConstructors Word64
i =
  Text -> Get Int -> ByteString -> Either DecodeError Int
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr (Text
"lookupDeclElementNumConstructors " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tShow Word64
i) (Word64 -> m Int
forall (m :: * -> *). MonadGet m => Word64 -> m Int
Serialization.lookupDeclElementNumConstructors Word64
i)

decodeDeclFormat :: ByteString -> Either DecodeError DeclFormat.DeclFormat
decodeDeclFormat :: ByteString -> Either DecodeError DeclFormat
decodeDeclFormat =
  Text
-> Get DeclFormat -> ByteString -> Either DecodeError DeclFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getDeclFormat" m DeclFormat
Get DeclFormat
Serialization.getDeclFormat

decodePatchFormat :: ByteString -> Either DecodeError PatchFormat.PatchFormat
decodePatchFormat :: ByteString -> Either DecodeError PatchFormat
decodePatchFormat =
  Text
-> Get PatchFormat -> ByteString -> Either DecodeError PatchFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getPatchFormat" m PatchFormat
Get PatchFormat
Serialization.getPatchFormat

decodeSyncDeclFormat :: ByteString -> Either DecodeError DeclFormat.SyncDeclFormat
decodeSyncDeclFormat :: ByteString -> Either DecodeError SyncDeclFormat
decodeSyncDeclFormat =
  Text
-> Get SyncDeclFormat
-> ByteString
-> Either DecodeError SyncDeclFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"decomposeDeclFormat" m SyncDeclFormat
Get SyncDeclFormat
Serialization.decomposeDeclFormat

decodeSyncNamespaceFormat :: ByteString -> Either DecodeError NamespaceFormat.SyncBranchFormat
decodeSyncNamespaceFormat :: ByteString -> Either DecodeError SyncBranchFormat
decodeSyncNamespaceFormat =
  Text
-> Get SyncBranchFormat
-> ByteString
-> Either DecodeError SyncBranchFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"decomposeNamespaceFormat" m SyncBranchFormat
Get SyncBranchFormat
Serialization.decomposeBranchFormat

decodeSyncPatchFormat :: ByteString -> Either DecodeError PatchFormat.SyncPatchFormat
decodeSyncPatchFormat :: ByteString -> Either DecodeError SyncPatchFormat
decodeSyncPatchFormat =
  Text
-> Get SyncPatchFormat
-> ByteString
-> Either DecodeError SyncPatchFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"decomposePatchFormat" m SyncPatchFormat
Get SyncPatchFormat
Serialization.decomposePatchFormat

decodeSyncTermFormat :: ByteString -> Either DecodeError TermFormat.SyncTermFormat
decodeSyncTermFormat :: ByteString -> Either DecodeError SyncTermFormat
decodeSyncTermFormat =
  Text
-> Get SyncTermFormat
-> ByteString
-> Either DecodeError SyncTermFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"decomposeTermFormat" m SyncTermFormat
Get SyncTermFormat
Serialization.decomposeTermFormat

-- | N.B. The bytestring here is not the entire object.bytes column --
-- it's just the serialized term and type from 'TermFormat.SyncTermFormat'.
decodeSyncTermAndType :: ByteString -> Either DecodeError (TermFormat.Term, TermFormat.Type)
decodeSyncTermAndType :: ByteString -> Either DecodeError (Term, Type)
decodeSyncTermAndType =
  Text
-> Get (Term, Type)
-> ByteString
-> Either DecodeError (Term, Type)
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getTermAndType" m (Term, Type)
Get (Term, Type)
Serialization.getTermAndType

-- | N.B. The bytestring here is not the entire object.bytes column --
-- it's just the serialized decl from 'DeclFormat.SyncDeclFormat'.
decodeDecl :: ByteString -> Either DecodeError (DeclFormat.Decl Symbol)
decodeDecl :: ByteString -> Either DecodeError (Decl Symbol)
decodeDecl =
  Text
-> Get (Decl Symbol)
-> ByteString
-> Either DecodeError (Decl Symbol)
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getDeclElement" m (Decl Symbol)
Get (Decl Symbol)
Serialization.getDeclElement

decodeTermFormat :: ByteString -> Either DecodeError TermFormat.TermFormat
decodeTermFormat :: ByteString -> Either DecodeError TermFormat
decodeTermFormat =
  Text
-> Get TermFormat -> ByteString -> Either DecodeError TermFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getTermFormat" m TermFormat
Get TermFormat
Serialization.getTermFormat

decodeTermElementDiscardingTerm :: C.Reference.Pos -> ByteString -> Either DecodeError (LocalIds, TermFormat.Type)
decodeTermElementDiscardingTerm :: Word64 -> ByteString -> Either DecodeError (LocalIds, Type)
decodeTermElementDiscardingTerm Word64
i =
  Text
-> Get (LocalIds, Type)
-> ByteString
-> Either DecodeError (LocalIds, Type)
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr (Text
"lookupTermElementDiscardingTerm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tShow Word64
i) (Word64 -> m (LocalIds, Type)
forall (m :: * -> *). MonadGet m => Word64 -> m (LocalIds, Type)
Serialization.lookupTermElementDiscardingTerm Word64
i)

decodeTermElementDiscardingType :: C.Reference.Pos -> ByteString -> Either DecodeError (LocalIds, TermFormat.Term)
decodeTermElementDiscardingType :: Word64 -> ByteString -> Either DecodeError (LocalIds, Term)
decodeTermElementDiscardingType Word64
i =
  Text
-> Get (LocalIds, Term)
-> ByteString
-> Either DecodeError (LocalIds, Term)
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr (Text
"lookupTermElementDiscardingType " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tShow Word64
i) (Word64 -> m (LocalIds, Term)
forall (m :: * -> *). MonadGet m => Word64 -> m (LocalIds, Term)
Serialization.lookupTermElementDiscardingType Word64
i)

decodeTermElementWithType ::
  C.Reference.Pos ->
  ByteString ->
  Either DecodeError (LocalIds, TermFormat.Term, TermFormat.Type)
decodeTermElementWithType :: Word64 -> ByteString -> Either DecodeError (LocalIds, Term, Type)
decodeTermElementWithType Word64
i =
  Text
-> Get (LocalIds, Term, Type)
-> ByteString
-> Either DecodeError (LocalIds, Term, Type)
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr (Text
"lookupTermElement" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tShow Word64
i) (Word64 -> m (LocalIds, Term, Type)
forall (m :: * -> *).
MonadGet m =>
Word64 -> m (LocalIds, Term, Type)
Serialization.lookupTermElement Word64
i)

------------------------------------------------------------------------------------------------------------------------
-- temp_entity.blob

decodeTempCausalFormat :: ByteString -> Either DecodeError TempEntity.TempCausalFormat
decodeTempCausalFormat :: ByteString -> Either DecodeError TempCausalFormat
decodeTempCausalFormat =
  Text
-> Get TempCausalFormat
-> ByteString
-> Either DecodeError TempCausalFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getTempCausalFormat" m TempCausalFormat
Get TempCausalFormat
Serialization.getTempCausalFormat

decodeTempDeclFormat :: ByteString -> Either DecodeError TempEntity.TempDeclFormat
decodeTempDeclFormat :: ByteString -> Either DecodeError TempDeclFormat
decodeTempDeclFormat =
  Text
-> Get TempDeclFormat
-> ByteString
-> Either DecodeError TempDeclFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getTempDeclFormat" m TempDeclFormat
Get TempDeclFormat
Serialization.getTempDeclFormat

decodeTempNamespaceFormat :: ByteString -> Either DecodeError TempEntity.TempNamespaceFormat
decodeTempNamespaceFormat :: ByteString -> Either DecodeError TempNamespaceFormat
decodeTempNamespaceFormat =
  Text
-> Get TempNamespaceFormat
-> ByteString
-> Either DecodeError TempNamespaceFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getTempNamespaceFormat" m TempNamespaceFormat
Get TempNamespaceFormat
Serialization.getTempNamespaceFormat

decodeTempPatchFormat :: ByteString -> Either DecodeError TempEntity.TempPatchFormat
decodeTempPatchFormat :: ByteString -> Either DecodeError TempPatchFormat
decodeTempPatchFormat =
  Text
-> Get TempPatchFormat
-> ByteString
-> Either DecodeError TempPatchFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getTempPatchFormat" m TempPatchFormat
Get TempPatchFormat
Serialization.getTempPatchFormat

decodeTempTermFormat :: ByteString -> Either DecodeError TempEntity.TempTermFormat
decodeTempTermFormat :: ByteString -> Either DecodeError TempTermFormat
decodeTempTermFormat =
  Text
-> Get TempTermFormat
-> ByteString
-> Either DecodeError TempTermFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getTempTermFormat" m TempTermFormat
Get TempTermFormat
Serialization.getTempTermFormat

------------------------------------------------------------------------------------------------------------------------
-- watch_result.result

decodeWatchResultFormat :: ByteString -> Either DecodeError TermFormat.WatchResultFormat
decodeWatchResultFormat :: ByteString -> Either DecodeError WatchResultFormat
decodeWatchResultFormat =
  Text
-> Get WatchResultFormat
-> ByteString
-> Either DecodeError WatchResultFormat
forall a. Text -> Get a -> ByteString -> Either DecodeError a
getFromBytesOr Text
"getWatchResultFormat" m WatchResultFormat
Get WatchResultFormat
Serialization.getWatchResultFormat

------------------------------------------------------------------------------------------------------------------------
-- unsyncs

unsyncTermComponent :: (HasCallStack) => TermFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (TermFormat.LocallyIndexedComponent' t d)
unsyncTermComponent :: forall t d.
HasCallStack =>
SyncLocallyIndexedComponent' t d
-> Either DecodeError (LocallyIndexedComponent' t d)
unsyncTermComponent (TermFormat.SyncLocallyIndexedComponent Vector (LocalIds' t d, ByteString)
terms) = do
  let phi :: (a, ByteString) -> Either DecodeError (a, Term, Type)
phi (a
localIds, ByteString
bs) = do
        (Term
a, Type
b) <- ByteString -> Either DecodeError (Term, Type)
decodeSyncTermAndType ByteString
bs
        (a, Term, Type) -> Either DecodeError (a, Term, Type)
forall a. a -> Either DecodeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, Term, Type) -> Either DecodeError (a, Term, Type))
-> (a, Term, Type) -> Either DecodeError (a, Term, Type)
forall a b. (a -> b) -> a -> b
$ (a
localIds, Term
a, Type
b)
  Vector (LocalIds' t d, Term, Type) -> LocallyIndexedComponent' t d
forall t d.
Vector (LocalIds' t d, Term, Type) -> LocallyIndexedComponent' t d
TermFormat.LocallyIndexedComponent (Vector (LocalIds' t d, Term, Type)
 -> LocallyIndexedComponent' t d)
-> Either DecodeError (Vector (LocalIds' t d, Term, Type))
-> Either DecodeError (LocallyIndexedComponent' t d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LocalIds' t d, ByteString)
 -> Either DecodeError (LocalIds' t d, Term, Type))
-> Vector (LocalIds' t d, ByteString)
-> Either DecodeError (Vector (LocalIds' t d, Term, Type))
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) -> Vector a -> f (Vector b)
traverse (LocalIds' t d, ByteString)
-> Either DecodeError (LocalIds' t d, Term, Type)
forall {a}. (a, ByteString) -> Either DecodeError (a, Term, Type)
phi Vector (LocalIds' t d, ByteString)
terms

unsyncDeclComponent :: DeclFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (DeclFormat.LocallyIndexedComponent' t d)
unsyncDeclComponent :: forall t d.
SyncLocallyIndexedComponent' t d
-> Either DecodeError (LocallyIndexedComponent' t d)
unsyncDeclComponent (DeclFormat.SyncLocallyIndexedComponent Vector (LocalIds' t d, ByteString)
decls) = do
  let phi :: (a, ByteString) -> Either DecodeError (a, Decl Symbol)
phi (a
localIds, ByteString
bs) = do
        Decl Symbol
decl <- ByteString -> Either DecodeError (Decl Symbol)
decodeDecl ByteString
bs
        pure (a
localIds, Decl Symbol
decl)
  Vector (LocalIds' t d, Decl Symbol) -> LocallyIndexedComponent' t d
forall t d.
Vector (LocalIds' t d, Decl Symbol) -> LocallyIndexedComponent' t d
DeclFormat.LocallyIndexedComponent (Vector (LocalIds' t d, Decl Symbol)
 -> LocallyIndexedComponent' t d)
-> Either DecodeError (Vector (LocalIds' t d, Decl Symbol))
-> Either DecodeError (LocallyIndexedComponent' t d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LocalIds' t d, ByteString)
 -> Either DecodeError (LocalIds' t d, Decl Symbol))
-> Vector (LocalIds' t d, ByteString)
-> Either DecodeError (Vector (LocalIds' t d, Decl Symbol))
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) -> Vector a -> f (Vector b)
traverse (LocalIds' t d, ByteString)
-> Either DecodeError (LocalIds' t d, Decl Symbol)
forall {a}. (a, ByteString) -> Either DecodeError (a, Decl Symbol)
phi Vector (LocalIds' t d, ByteString)
decls