module U.Codebase.Decl.Hashing where

import Control.Lens
import Data.Foldable qualified as Foldable
import Data.Map qualified as Map
import U.Codebase.Decl qualified as C
import U.Codebase.Decl qualified as C.Decl
import U.Codebase.HashTags
import U.Codebase.Reference qualified as Reference
import U.Codebase.Sqlite.Decl.Format qualified as DeclFormat
import U.Codebase.Sqlite.HashHandle (HashMismatch (..))
import U.Codebase.Sqlite.HashHandle qualified as HH
import U.Codebase.Sqlite.LocalIds qualified as LocalIds
import U.Codebase.Sqlite.Queries qualified as Q
import U.Codebase.Sqlite.Symbol qualified as S
import U.Codebase.Sqlite.Symbol qualified as Sqlite
import Unison.Hash32
import Unison.Hash32 qualified as Hash32
import Unison.Hashing.V2 qualified as H2
import Unison.Hashing.V2.Convert2 qualified as H2
import Unison.Prelude
import Unison.Symbol qualified as Unison
import Unison.Syntax.Name qualified as Name
import Unison.Var qualified as Var

verifyDeclFormatHash :: ComponentHash -> DeclFormat.HashDeclFormat -> Maybe HH.DeclHashingError
verifyDeclFormatHash :: ComponentHash -> HashDeclFormat -> Maybe DeclHashingError
verifyDeclFormatHash (ComponentHash Hash
hash) (DeclFormat.Decl (DeclFormat.LocallyIndexedComponent Vector (LocalIds' Text Hash32, Decl Symbol)
elements)) =
  Vector (LocalIds' Text Hash32, Decl Symbol)
-> [(LocalIds' Text Hash32, Decl Symbol)]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Vector (LocalIds' Text Hash32, Decl Symbol)
elements
    [(LocalIds' Text Hash32, Decl Symbol)]
-> ([(LocalIds' Text Hash32, Decl Symbol)] -> [Decl Symbol])
-> [Decl Symbol]
forall a b. a -> (a -> b) -> b
& ((LocalIds' Text Hash32, Decl Symbol) -> Decl Symbol)
-> [(LocalIds' Text Hash32, Decl Symbol)] -> [Decl Symbol]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LocalIds' Text Hash32, Decl Symbol) -> Decl Symbol
s2cDecl
    [Decl Symbol]
-> ([Decl Symbol] -> [(Decl Symbol, Id)]) -> [(Decl Symbol, Id)]
forall a b. a -> (a -> b) -> b
& Hash -> [Decl Symbol] -> [(Decl Symbol, Id)]
forall k. Hash -> [k] -> [(k, Id)]
Reference.component Hash
hash
    [(Decl Symbol, Id)]
-> ([(Decl Symbol, Id)] -> [(Id, (DeclR TypeRef Symbol, ()))])
-> [(Id, (DeclR TypeRef Symbol, ()))]
forall a b. a -> (a -> b) -> b
& ((Decl Symbol, Id) -> (Id, (DeclR TypeRef Symbol, ())))
-> [(Decl Symbol, Id)] -> [(Id, (DeclR TypeRef Symbol, ()))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Decl Symbol
decl, Id
refId) -> (Id
refId, ((Symbol -> Symbol) -> Decl Symbol -> DeclR TypeRef Symbol
forall v' v r. Ord v' => (v -> v') -> DeclR r v -> DeclR r v'
C.Decl.vmap Symbol -> Symbol
symbol2to1 Decl Symbol
decl, ())))
    [(Id, (DeclR TypeRef Symbol, ()))]
-> ([(Id, (DeclR TypeRef Symbol, ()))]
    -> Map Id (DeclR TypeRef Symbol, ()))
-> Map Id (DeclR TypeRef Symbol, ())
forall a b. a -> (a -> b) -> b
& [(Id, (DeclR TypeRef Symbol, ()))]
-> Map Id (DeclR TypeRef Symbol, ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    Map Id (DeclR TypeRef Symbol, ())
-> (Map Id (DeclR TypeRef Symbol, ())
    -> Map Id (Symbol, HashableDecl Symbol, ()))
-> Map Id (Symbol, HashableDecl Symbol, ())
forall a b. a -> (a -> b) -> b
& Hash
-> (Id -> Symbol)
-> Map Id (DeclR TypeRef Symbol, ())
-> Map Id (Symbol, HashableDecl Symbol, ())
forall v extra.
Var v =>
Hash
-> (Id -> v)
-> Map Id (Decl v, extra)
-> Map Id (v, HashableDecl v, extra)
C.Decl.unhashComponent Hash
hash Id -> Symbol
forall v. Var v => Id -> v
Var.unnamedRef
    Map Id (Symbol, HashableDecl Symbol, ())
-> (Map Id (Symbol, HashableDecl Symbol, ())
    -> [(Id, (Symbol, HashableDecl Symbol, ()))])
-> [(Id, (Symbol, HashableDecl Symbol, ()))]
forall a b. a -> (a -> b) -> b
& Map Id (Symbol, HashableDecl Symbol, ())
-> [(Id, (Symbol, HashableDecl Symbol, ()))]
forall k a. Map k a -> [(k, a)]
Map.toList
    [(Id, (Symbol, HashableDecl Symbol, ()))]
-> ([(Id, (Symbol, HashableDecl Symbol, ()))]
    -> [(Symbol, DataDeclaration Symbol ())])
-> [(Symbol, DataDeclaration Symbol ())]
forall a b. a -> (a -> b) -> b
& ((Id, (Symbol, HashableDecl Symbol, ()))
 -> (Symbol, DataDeclaration Symbol ()))
-> [(Id, (Symbol, HashableDecl Symbol, ()))]
-> [(Symbol, DataDeclaration Symbol ())]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Id
_refId, (Symbol
v, HashableDecl Symbol
decl, ())) -> (Symbol
v, (EffectDeclaration Symbol () -> DataDeclaration Symbol ())
-> (DataDeclaration Symbol () -> DataDeclaration Symbol ())
-> Either (EffectDeclaration Symbol ()) (DataDeclaration Symbol ())
-> DataDeclaration Symbol ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EffectDeclaration Symbol () -> DataDeclaration Symbol ()
forall v a. EffectDeclaration v a -> DataDeclaration v a
H2.toDataDecl DataDeclaration Symbol () -> DataDeclaration Symbol ()
forall a. a -> a
id (Either (EffectDeclaration Symbol ()) (DataDeclaration Symbol ())
 -> DataDeclaration Symbol ())
-> Either (EffectDeclaration Symbol ()) (DataDeclaration Symbol ())
-> DataDeclaration Symbol ()
forall a b. (a -> b) -> a -> b
$ HashableDecl Symbol
-> Either (EffectDeclaration Symbol ()) (DataDeclaration Symbol ())
H2.v2ToH2Decl HashableDecl Symbol
decl))
    [(Symbol, DataDeclaration Symbol ())]
-> ([(Symbol, DataDeclaration Symbol ())]
    -> Map Symbol (DataDeclaration Symbol ()))
-> Map Symbol (DataDeclaration Symbol ())
forall a b. a -> (a -> b) -> b
& [(Symbol, DataDeclaration Symbol ())]
-> Map Symbol (DataDeclaration Symbol ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    Map Symbol (DataDeclaration Symbol ())
-> (Map Symbol (DataDeclaration Symbol ())
    -> ResolutionResult
         () [(Symbol, ReferenceId, DataDeclaration Symbol ())])
-> ResolutionResult
     () [(Symbol, ReferenceId, DataDeclaration Symbol ())]
forall a b. a -> (a -> b) -> b
& (Symbol -> Name)
-> Map Symbol (DataDeclaration Symbol ())
-> ResolutionResult
     () [(Symbol, ReferenceId, DataDeclaration Symbol ())]
forall v a.
(Eq v, Var v, Show v) =>
(v -> Name)
-> Map v (DataDeclaration v a)
-> ResolutionResult a [(v, ReferenceId, DataDeclaration v a)]
H2.hashDecls Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar
    ResolutionResult
  () [(Symbol, ReferenceId, DataDeclaration Symbol ())]
-> (ResolutionResult
      () [(Symbol, ReferenceId, DataDeclaration Symbol ())]
    -> Maybe DeclHashingError)
-> Maybe DeclHashingError
forall a b. a -> (a -> b) -> b
& \case
      Left Seq (ResolutionFailure ())
_err -> DeclHashingError -> Maybe DeclHashingError
forall a. a -> Maybe a
Just DeclHashingError
HH.DeclHashResolutionFailure
      Right [(Symbol, ReferenceId, DataDeclaration Symbol ())]
m ->
        [(Symbol, ReferenceId, DataDeclaration Symbol ())]
m
          [(Symbol, ReferenceId, DataDeclaration Symbol ())]
-> ([(Symbol, ReferenceId, DataDeclaration Symbol ())]
    -> Maybe DeclHashingError)
-> Maybe DeclHashingError
forall a b. a -> (a -> b) -> b
& ((Symbol, ReferenceId, DataDeclaration Symbol ())
 -> Maybe DeclHashingError)
-> [(Symbol, ReferenceId, DataDeclaration Symbol ())]
-> Maybe DeclHashingError
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap \(Symbol
_, H2.ReferenceId Hash
hash' Pos
_, DataDeclaration Symbol ()
_) ->
            if Hash
hash Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hash'
              then Maybe DeclHashingError
forall a. Maybe a
Nothing
              else DeclHashingError -> Maybe DeclHashingError
forall a. a -> Maybe a
Just (HashMismatch -> DeclHashingError
HH.DeclHashMismatch (HashMismatch -> DeclHashingError)
-> HashMismatch -> DeclHashingError
forall a b. (a -> b) -> a -> b
$ Hash -> Hash -> HashMismatch
HashMismatch Hash
hash Hash
hash')
  where
    symbol2to1 :: S.Symbol -> Unison.Symbol
    symbol2to1 :: Symbol -> Symbol
symbol2to1 (S.Symbol Pos
i Text
t) = Pos -> Type -> Symbol
Unison.Symbol Pos
i (Text -> Type
Var.User Text
t)

s2cDecl :: (LocalIds.LocalIds' Text Hash32, DeclFormat.Decl Sqlite.Symbol) -> C.Decl Sqlite.Symbol
s2cDecl :: (LocalIds' Text Hash32, Decl Symbol) -> Decl Symbol
s2cDecl (LocalIds' Text Hash32
ids, Decl Symbol
decl) =
  let Identity (LocalTextId -> Text
substText, LocalDefnId -> Hash
substHash) = (Text -> Identity Text)
-> (Hash -> Identity Hash)
-> LocalIds' Text Hash
-> Identity (LocalTextId -> Text, LocalDefnId -> Hash)
forall (m :: * -> *) t d.
Monad m =>
(t -> m Text)
-> (d -> m Hash)
-> LocalIds' t d
-> m (LocalTextId -> Text, LocalDefnId -> Hash)
Q.localIdsToLookups Text -> Identity Text
forall a. a -> Identity a
Identity Hash -> Identity Hash
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text -> Text)
-> (Hash32 -> Hash) -> LocalIds' Text Hash32 -> LocalIds' Text Hash
forall a b c d.
(a -> b) -> (c -> d) -> LocalIds' a c -> LocalIds' b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Text
forall a. a -> a
id Hash32 -> Hash
Hash32.toHash LocalIds' Text Hash32
ids)
      refmap :: Reference' LocalTextId (Maybe LocalDefnId) -> TypeRef
refmap = ((LocalTextId -> Text)
-> (Maybe LocalDefnId -> Maybe Hash)
-> Reference' LocalTextId (Maybe LocalDefnId)
-> TypeRef
forall a b c d.
(a -> b) -> (c -> d) -> Reference' a c -> Reference' b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap LocalTextId -> Text
substText ((LocalDefnId -> Hash) -> Maybe LocalDefnId -> Maybe Hash
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalDefnId -> Hash
substHash))
   in (Reference' LocalTextId (Maybe LocalDefnId) -> TypeRef)
-> Decl Symbol -> Decl Symbol
forall r r1. (r -> r1) -> DeclR r Symbol -> DeclR r1 Symbol
Q.x2cDecl Reference' LocalTextId (Maybe LocalDefnId) -> TypeRef
refmap Decl Symbol
decl