-- | The "decl coherency check": a type declaration in a namespace is "coherent" if it satisfies both of the following
-- criteria.
--
--   1. For each naming of the type decl (say "Foo"#foohash), there exists exactly one name for each of its constructors
--      arbitrarily deep in the corresponding namespace ("Foo" in this example).
--
--      This allows us to render the decl naturally, as in
--
--        structural type Foo
--          = Bar Nat Int
--          | internal.hello.Bonk Nat
--
--      which corresponds to the three names
--
--        "Foo"                     => #foohash
--        "Foo.Bar"                 => #foohash#0
--        "Foo.internal.hello.Bonk" => #foohash#1
--
--      We could not do if there was at least one constructor whose full name does not contain the full name of the type
--      decl itself as a prefix.
--
--      A notable consequence of this requirement is that a second naming of a decl (i.e. an alias) cannot be embedded
--      within the first naming, as in:
--
--        type Foo = ...
--        type Foo.some.inner.namespace = ... -- an alias of Foo
--
--   2. No constructor has a "stray" name that does not have a prefix that equals the type declaration's name. For
--      example, in the namespace
--
--        "Foo"                 => #foohash
--        "Foo.Bar"             => #foohash#0
--        "Deep.What.SomeAlias" => #foohash#0
--
--      the constructor "What.SomeAlias" is "stray", as the type decl #foohash has no name that matches any prefix
--      (i.e. "Deep.What" nor "Deep").
--
-- On to the implementation. We are going to traverse the namespace depth-first. As we go, we have a stateful mapping
-- between decl reference that we *have* seen a name for in one of our parent namespace, and its corresponding set of
-- constructors that we *haven't* yet seen names for, but expect to, before fully searching the corresponding
-- sub-namespace (e.g. the child namespace named "Foo" of the namepace that declares a decl "Foo").
--
-- When processing a namespace, we first process all terms. Each constructor will fall into one of three cases:
--
-- > +----------------------------------------------------------------------------------------------------------------+
-- > | Case         | Mapping before       | Encountered constructor | Mapping after                                  |
-- > +----------------------------------------------------------------------------------------------------------------+
-- > | Happy path   | { #foo : {0, 1, 2} } | #foo#1                  | { #foo : {0, 2} }                              |
-- > | Already seen | { #foo : {0, 1, 2} } | #foo#5                  | Error: duplicate naming for constructor #foo#5 |
-- > | Never seen   | { #foo : {0, 1, 2} } | #bar#2                  | Error: stray constructor #bar#2                |
-- > +----------------------------------------------------------------------------------------------------------------+
--
-- In "happy path", we see a naming of a constructor that we're expecting, and check it off.
-- In "already seen", we see a second naming of a constructor that we're no longer expecting, and fail.
-- In "never seen", we see a naming of a constructor before any naming of its decl, so we fail.
--
-- Next, we process all type decls. Each will again fall into one of three cases:
--
-- > +-----------------------------------------------------------------------------------------------------+
-- > | Case             | Mapping before       | Declaration | Num constructors | New mapping              |
-- > +-----------------------------------------------------------------------------------------------------+
-- > | Uninhabited decl |                      | #foo        | 0                |                          |
-- > | Inhabited decl   |                      | #foo        | 1 or more        | { #foo : {0, ..., n-1} } |
-- > | Already seen     | { foo : {0, 1, 2}  } | #foo        | Irrelevant       | Error: nested decl alias |
-- > +-----------------------------------------------------------------------------------------------------+
--
-- In "uninhabited decl", we find a decl with no constructors, so we don't expect anything new.
-- In "already seen", we find a second naming of a decl, whose constructors will necessarily violate coherency condition
--   (1) above.
--
-- In "inhabited decl", we find a decl with N constructors, and handle it by:
--   1. Adding to our state that we expect a name for each.
--   2. Recursing into the child namespace whose name matches the decl.
--   3. (If we return from the recursion without short-circuiting) remove the mapping added in step (1) and assert that
--      its value is the empty set (meaning we encountered a name for every constructor).
--
-- Note: This check could be moved into SQLite (with sufficient schema support) some day, but for now, we just do this
-- in memory.
--
-- Note: once upon a time, decls could be "incoherent". Then, we decided we want decls to be "coherent". Thus, this
-- machinery was invented.
module Unison.Merge.DeclCoherencyCheck
  ( IncoherentDeclReason (..),
    checkDeclCoherency,
    lenientCheckDeclCoherency,

    -- * Getting all failures rather than just the first
    IncoherentDeclReasons (..),
    checkAllDeclCoherency,
  )
where

import Control.Lens ((%=), (.=), _2)
import Control.Monad.State.Strict (StateT)
import Control.Monad.State.Strict qualified as State
import Control.Monad.Trans.State.Strict (State)
import Data.Functor.Compose (Compose (..))
import Data.IntMap.Strict (IntMap)
import Data.IntMap.Strict qualified as IntMap
import Data.List qualified as List
import Data.List.NonEmpty (pattern (:|))
import Data.Map.Strict qualified as Map
import Data.Maybe (fromJust)
import Data.Set qualified as Set
import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId)
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration.ConstructorId (ConstructorId)
import Unison.DeclNameLookup (DeclNameLookup (..))
import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..))
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.Prelude
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Map qualified as Map (deleteLookup, deleteLookupJust, upsertF)
import Unison.Util.Nametree (Nametree (..))

data IncoherentDeclReason
  = -- | A second naming of a constructor was discovered underneath a decl's name, e.g.
    --
    --   Foo#Foo
    --   Foo.Bar#Foo#0
    --   Foo.Some.Other.Name.For.Bar#Foo#0
    IncoherentDeclReason'ConstructorAlias !Name !Name !Name -- type, first constructor, second constructor
  | IncoherentDeclReason'MissingConstructorName !Name
  | -- | A second naming of a decl was discovered underneath its name, e.g.
    --
    --   Foo#Foo
    --   Foo.Bar#Foo
    IncoherentDeclReason'NestedDeclAlias !Name !Name -- shorter name, longer name
  | IncoherentDeclReason'StrayConstructor !TypeReferenceId !Name
  deriving stock (Int -> IncoherentDeclReason -> ShowS
[IncoherentDeclReason] -> ShowS
IncoherentDeclReason -> String
(Int -> IncoherentDeclReason -> ShowS)
-> (IncoherentDeclReason -> String)
-> ([IncoherentDeclReason] -> ShowS)
-> Show IncoherentDeclReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IncoherentDeclReason -> ShowS
showsPrec :: Int -> IncoherentDeclReason -> ShowS
$cshow :: IncoherentDeclReason -> String
show :: IncoherentDeclReason -> String
$cshowList :: [IncoherentDeclReason] -> ShowS
showList :: [IncoherentDeclReason] -> ShowS
Show)

checkDeclCoherency ::
  (HasCallStack) =>
  Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
  Map TypeReferenceId Int ->
  Either IncoherentDeclReason DeclNameLookup
checkDeclCoherency :: HasCallStack =>
Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Map (Id' Hash) Int -> Either IncoherentDeclReason DeclNameLookup
checkDeclCoherency Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree Map (Id' Hash) Int
numConstructorsById =
  (Id' Hash -> Either IncoherentDeclReason Int)
-> OnIncoherentDeclReasons (Either IncoherentDeclReason)
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Either IncoherentDeclReason DeclNameLookup
forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> m DeclNameLookup
checkDeclCoherencyWith
    (\Id' Hash
refId -> Int -> Either IncoherentDeclReason Int
forall a b. b -> Either a b
Right (HasCallStack => Id' Hash -> Map (Id' Hash) Int -> Int
Id' Hash -> Map (Id' Hash) Int -> Int
expectNumConstructors Id' Hash
refId Map (Id' Hash) Int
numConstructorsById))
    OnIncoherentDeclReasons
      { $sel:onConstructorAlias:OnIncoherentDeclReasons :: Name -> Name -> Name -> Either IncoherentDeclReason ()
onConstructorAlias = \Name
x Name
y Name
z -> IncoherentDeclReason -> Either IncoherentDeclReason ()
forall a b. a -> Either a b
Left (Name -> Name -> Name -> IncoherentDeclReason
IncoherentDeclReason'ConstructorAlias Name
x Name
y Name
z),
        $sel:onMissingConstructorName:OnIncoherentDeclReasons :: Name -> Either IncoherentDeclReason ()
onMissingConstructorName = \Name
x -> IncoherentDeclReason -> Either IncoherentDeclReason ()
forall a b. a -> Either a b
Left (Name -> IncoherentDeclReason
IncoherentDeclReason'MissingConstructorName Name
x),
        $sel:onNestedDeclAlias:OnIncoherentDeclReasons :: Name -> Name -> Either IncoherentDeclReason ()
onNestedDeclAlias = \Name
x Name
y -> IncoherentDeclReason -> Either IncoherentDeclReason ()
forall a b. a -> Either a b
Left (Name -> Name -> IncoherentDeclReason
IncoherentDeclReason'NestedDeclAlias Name
x Name
y),
        $sel:onStrayConstructor:OnIncoherentDeclReasons :: Id' Hash -> Name -> Either IncoherentDeclReason ()
onStrayConstructor = \Id' Hash
x Name
y -> IncoherentDeclReason -> Either IncoherentDeclReason ()
forall a b. a -> Either a b
Left (Id' Hash -> Name -> IncoherentDeclReason
IncoherentDeclReason'StrayConstructor Id' Hash
x Name
y)
      }
    Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree

data IncoherentDeclReasons = IncoherentDeclReasons
  { IncoherentDeclReasons -> [(Name, Name, Name)]
constructorAliases :: ![(Name, Name, Name)],
    IncoherentDeclReasons -> [Name]
missingConstructorNames :: ![Name],
    IncoherentDeclReasons -> [(Name, Name)]
nestedDeclAliases :: ![(Name, Name)],
    IncoherentDeclReasons -> [(Id' Hash, Name)]
strayConstructors :: ![(TypeReferenceId, Name)]
  }
  deriving stock (IncoherentDeclReasons -> IncoherentDeclReasons -> Bool
(IncoherentDeclReasons -> IncoherentDeclReasons -> Bool)
-> (IncoherentDeclReasons -> IncoherentDeclReasons -> Bool)
-> Eq IncoherentDeclReasons
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IncoherentDeclReasons -> IncoherentDeclReasons -> Bool
== :: IncoherentDeclReasons -> IncoherentDeclReasons -> Bool
$c/= :: IncoherentDeclReasons -> IncoherentDeclReasons -> Bool
/= :: IncoherentDeclReasons -> IncoherentDeclReasons -> Bool
Eq, (forall x. IncoherentDeclReasons -> Rep IncoherentDeclReasons x)
-> (forall x. Rep IncoherentDeclReasons x -> IncoherentDeclReasons)
-> Generic IncoherentDeclReasons
forall x. Rep IncoherentDeclReasons x -> IncoherentDeclReasons
forall x. IncoherentDeclReasons -> Rep IncoherentDeclReasons x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IncoherentDeclReasons -> Rep IncoherentDeclReasons x
from :: forall x. IncoherentDeclReasons -> Rep IncoherentDeclReasons x
$cto :: forall x. Rep IncoherentDeclReasons x -> IncoherentDeclReasons
to :: forall x. Rep IncoherentDeclReasons x -> IncoherentDeclReasons
Generic)

-- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first.
checkAllDeclCoherency ::
  forall m.
  (Monad m) =>
  (TypeReferenceId -> m Int) ->
  Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
  m (Either IncoherentDeclReasons DeclNameLookup)
checkAllDeclCoherency :: forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> m (Either IncoherentDeclReasons DeclNameLookup)
checkAllDeclCoherency Id' Hash -> m Int
loadDeclNumConstructors Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree = do
  StateT IncoherentDeclReasons m DeclNameLookup
-> IncoherentDeclReasons
-> m (DeclNameLookup, IncoherentDeclReasons)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT StateT IncoherentDeclReasons m DeclNameLookup
doCheck IncoherentDeclReasons
emptyReasons m (DeclNameLookup, IncoherentDeclReasons)
-> ((DeclNameLookup, IncoherentDeclReasons)
    -> Either IncoherentDeclReasons DeclNameLookup)
-> m (Either IncoherentDeclReasons DeclNameLookup)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(DeclNameLookup
declNameLookup, IncoherentDeclReasons
reasons) ->
    if IncoherentDeclReasons
reasons IncoherentDeclReasons -> IncoherentDeclReasons -> Bool
forall a. Eq a => a -> a -> Bool
== IncoherentDeclReasons
emptyReasons
      then DeclNameLookup -> Either IncoherentDeclReasons DeclNameLookup
forall a b. b -> Either a b
Right DeclNameLookup
declNameLookup
      else IncoherentDeclReasons
-> Either IncoherentDeclReasons DeclNameLookup
forall a b. a -> Either a b
Left (IncoherentDeclReasons -> IncoherentDeclReasons
reverseReasons IncoherentDeclReasons
reasons)
  where
    doCheck :: StateT IncoherentDeclReasons m DeclNameLookup
    doCheck :: StateT IncoherentDeclReasons m DeclNameLookup
doCheck =
      (Id' Hash -> StateT IncoherentDeclReasons m Int)
-> OnIncoherentDeclReasons (StateT IncoherentDeclReasons m)
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT IncoherentDeclReasons m DeclNameLookup
forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> m DeclNameLookup
checkDeclCoherencyWith
        (m Int -> StateT IncoherentDeclReasons m Int
forall (m :: * -> *) a.
Monad m =>
m a -> StateT IncoherentDeclReasons m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Int -> StateT IncoherentDeclReasons m Int)
-> (Id' Hash -> m Int)
-> Id' Hash
-> StateT IncoherentDeclReasons m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id' Hash -> m Int
loadDeclNumConstructors)
        ( OnIncoherentDeclReasons
            { $sel:onConstructorAlias:OnIncoherentDeclReasons :: Name -> Name -> Name -> StateT IncoherentDeclReasons m ()
onConstructorAlias = \Name
x Name
y Name
z -> ASetter
  IncoherentDeclReasons
  IncoherentDeclReasons
  [(Name, Name, Name)]
  [(Name, Name, Name)]
#constructorAliases ASetter
  IncoherentDeclReasons
  IncoherentDeclReasons
  [(Name, Name, Name)]
  [(Name, Name, Name)]
-> ([(Name, Name, Name)] -> [(Name, Name, Name)])
-> StateT IncoherentDeclReasons m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Name
x, Name
y, Name
z) (Name, Name, Name) -> [(Name, Name, Name)] -> [(Name, Name, Name)]
forall a. a -> [a] -> [a]
:),
              $sel:onMissingConstructorName:OnIncoherentDeclReasons :: Name -> StateT IncoherentDeclReasons m ()
onMissingConstructorName = \Name
x -> ASetter IncoherentDeclReasons IncoherentDeclReasons [Name] [Name]
#missingConstructorNames ASetter IncoherentDeclReasons IncoherentDeclReasons [Name] [Name]
-> ([Name] -> [Name]) -> StateT IncoherentDeclReasons m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Name
x Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:),
              $sel:onNestedDeclAlias:OnIncoherentDeclReasons :: Name -> Name -> StateT IncoherentDeclReasons m ()
onNestedDeclAlias = \Name
x Name
y -> ASetter
  IncoherentDeclReasons
  IncoherentDeclReasons
  [(Name, Name)]
  [(Name, Name)]
#nestedDeclAliases ASetter
  IncoherentDeclReasons
  IncoherentDeclReasons
  [(Name, Name)]
  [(Name, Name)]
-> ([(Name, Name)] -> [(Name, Name)])
-> StateT IncoherentDeclReasons m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Name
x, Name
y) (Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
:),
              $sel:onStrayConstructor:OnIncoherentDeclReasons :: Id' Hash -> Name -> StateT IncoherentDeclReasons m ()
onStrayConstructor = \Id' Hash
x Name
y -> ASetter
  IncoherentDeclReasons
  IncoherentDeclReasons
  [(Id' Hash, Name)]
  [(Id' Hash, Name)]
#strayConstructors ASetter
  IncoherentDeclReasons
  IncoherentDeclReasons
  [(Id' Hash, Name)]
  [(Id' Hash, Name)]
-> ([(Id' Hash, Name)] -> [(Id' Hash, Name)])
-> StateT IncoherentDeclReasons m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Id' Hash
x, Name
y) (Id' Hash, Name) -> [(Id' Hash, Name)] -> [(Id' Hash, Name)]
forall a. a -> [a] -> [a]
:)
            }
        )
        Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree

    emptyReasons :: IncoherentDeclReasons
    emptyReasons :: IncoherentDeclReasons
emptyReasons =
      [(Name, Name, Name)]
-> [Name]
-> [(Name, Name)]
-> [(Id' Hash, Name)]
-> IncoherentDeclReasons
IncoherentDeclReasons [] [] [] []

    reverseReasons :: IncoherentDeclReasons -> IncoherentDeclReasons
    reverseReasons :: IncoherentDeclReasons -> IncoherentDeclReasons
reverseReasons IncoherentDeclReasons
reasons =
      IncoherentDeclReasons
        { $sel:constructorAliases:IncoherentDeclReasons :: [(Name, Name, Name)]
constructorAliases = [(Name, Name, Name)] -> [(Name, Name, Name)]
forall a. [a] -> [a]
reverse IncoherentDeclReasons
reasons.constructorAliases,
          $sel:missingConstructorNames:IncoherentDeclReasons :: [Name]
missingConstructorNames = [Name] -> [Name]
forall a. [a] -> [a]
reverse IncoherentDeclReasons
reasons.missingConstructorNames,
          $sel:nestedDeclAliases:IncoherentDeclReasons :: [(Name, Name)]
nestedDeclAliases = [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a]
reverse IncoherentDeclReasons
reasons.nestedDeclAliases,
          $sel:strayConstructors:IncoherentDeclReasons :: [(Id' Hash, Name)]
strayConstructors = [(Id' Hash, Name)] -> [(Id' Hash, Name)]
forall a. [a] -> [a]
reverse IncoherentDeclReasons
reasons.strayConstructors
        }

data OnIncoherentDeclReasons m = OnIncoherentDeclReasons
  { forall (m :: * -> *).
OnIncoherentDeclReasons m -> Name -> Name -> Name -> m ()
onConstructorAlias :: Name -> Name -> Name -> m (),
    forall (m :: * -> *). OnIncoherentDeclReasons m -> Name -> m ()
onMissingConstructorName :: Name -> m (),
    forall (m :: * -> *).
OnIncoherentDeclReasons m -> Name -> Name -> m ()
onNestedDeclAlias :: Name -> Name -> m (),
    forall (m :: * -> *).
OnIncoherentDeclReasons m -> Id' Hash -> Name -> m ()
onStrayConstructor :: TypeReferenceId -> Name -> m ()
  }

checkDeclCoherencyWith ::
  forall m.
  (Monad m) =>
  (TypeReferenceId -> m Int) ->
  OnIncoherentDeclReasons m ->
  Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
  m DeclNameLookup
checkDeclCoherencyWith :: forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> m DeclNameLookup
checkDeclCoherencyWith Id' Hash -> m Int
loadDeclNumConstructors OnIncoherentDeclReasons m
callbacks =
  (DeclCoherencyCheckState -> DeclNameLookup)
-> m DeclCoherencyCheckState -> m DeclNameLookup
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting DeclNameLookup DeclCoherencyCheckState DeclNameLookup
-> DeclCoherencyCheckState -> DeclNameLookup
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DeclNameLookup DeclCoherencyCheckState DeclNameLookup
#declNameLookup)
    (m DeclCoherencyCheckState -> m DeclNameLookup)
-> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> m DeclCoherencyCheckState)
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> m DeclNameLookup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT DeclCoherencyCheckState m ()
-> DeclCoherencyCheckState -> m DeclCoherencyCheckState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
`State.execStateT` Map (Id' Hash) (Name, ConstructorNames)
-> DeclNameLookup -> DeclCoherencyCheckState
DeclCoherencyCheckState Map (Id' Hash) (Name, ConstructorNames)
forall k a. Map k a
Map.empty (Map Name Name -> Map Name [Name] -> DeclNameLookup
DeclNameLookup Map Name Name
forall k a. Map k a
Map.empty Map Name [Name]
forall k a. Map k a
Map.empty))
    (StateT DeclCoherencyCheckState m () -> m DeclCoherencyCheckState)
-> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> StateT DeclCoherencyCheckState m ())
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> m DeclCoherencyCheckState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT DeclCoherencyCheckState m ()
go []
  where
    go ::
      [NameSegment] ->
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
      StateT DeclCoherencyCheckState m ()
    go :: [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT DeclCoherencyCheckState m ()
go [NameSegment]
prefix (Nametree DefnsF (Map NameSegment) Referent TypeReference
defns Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children) = do
      [(NameSegment, Referent)]
-> ((NameSegment, Referent) -> StateT DeclCoherencyCheckState m ())
-> StateT DeclCoherencyCheckState m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
        (Map NameSegment Referent -> [(NameSegment, Referent)]
forall k a. Map k a -> [(k, a)]
Map.toList DefnsF (Map NameSegment) Referent TypeReference
defns.terms)
        ( OnIncoherentDeclReasons m
-> [NameSegment]
-> (NameSegment, Referent)
-> StateT DeclCoherencyCheckState m ()
forall (m :: * -> *).
Monad m =>
OnIncoherentDeclReasons m
-> [NameSegment]
-> (NameSegment, Referent)
-> StateT DeclCoherencyCheckState m ()
checkDeclCoherencyWith_DoTerms
            OnIncoherentDeclReasons m
callbacks
            [NameSegment]
prefix
        )
      [NameSegment]
childrenWeWentInto <-
        [(NameSegment, TypeReference)]
-> ((NameSegment, TypeReference)
    -> StateT DeclCoherencyCheckState m (Maybe NameSegment))
-> StateT DeclCoherencyCheckState m [NameSegment]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe
          (Map NameSegment TypeReference -> [(NameSegment, TypeReference)]
forall k a. Map k a -> [(k, a)]
Map.toList DefnsF (Map NameSegment) Referent TypeReference
defns.types)
          ((Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> ([NameSegment]
    -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> StateT DeclCoherencyCheckState m ())
-> [NameSegment]
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> (NameSegment, TypeReference)
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> ([NameSegment]
    -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> StateT DeclCoherencyCheckState m ())
-> [NameSegment]
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> (NameSegment, TypeReference)
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
checkDeclCoherencyWith_DoTypes Id' Hash -> m Int
loadDeclNumConstructors OnIncoherentDeclReasons m
callbacks [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT DeclCoherencyCheckState m ()
go [NameSegment]
prefix Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children)
      let childrenWeHaventGoneInto :: Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
childrenWeHaventGoneInto = Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Set NameSegment
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` [NameSegment] -> Set NameSegment
forall a. Ord a => [a] -> Set a
Set.fromList [NameSegment]
childrenWeWentInto
      [(NameSegment,
  Nametree (DefnsF (Map NameSegment) Referent TypeReference))]
-> ((NameSegment,
     Nametree (DefnsF (Map NameSegment) Referent TypeReference))
    -> StateT DeclCoherencyCheckState m ())
-> StateT DeclCoherencyCheckState m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> [(NameSegment,
     Nametree (DefnsF (Map NameSegment) Referent TypeReference))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
childrenWeHaventGoneInto) \(NameSegment
name, Nametree (DefnsF (Map NameSegment) Referent TypeReference)
child) -> [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT DeclCoherencyCheckState m ()
go (NameSegment
name NameSegment -> [NameSegment] -> [NameSegment]
forall a. a -> [a] -> [a]
: [NameSegment]
prefix) Nametree (DefnsF (Map NameSegment) Referent TypeReference)
child

checkDeclCoherencyWith_DoTerms ::
  forall m.
  (Monad m) =>
  OnIncoherentDeclReasons m ->
  [NameSegment] ->
  (NameSegment, Referent) ->
  StateT DeclCoherencyCheckState m ()
checkDeclCoherencyWith_DoTerms :: forall (m :: * -> *).
Monad m =>
OnIncoherentDeclReasons m
-> [NameSegment]
-> (NameSegment, Referent)
-> StateT DeclCoherencyCheckState m ()
checkDeclCoherencyWith_DoTerms OnIncoherentDeclReasons m
callbacks [NameSegment]
prefix (NameSegment
segment, Referent
ref) =
  Maybe ConstructorReferenceId
-> (ConstructorReferenceId -> StateT DeclCoherencyCheckState m ())
-> StateT DeclCoherencyCheckState m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Referent -> Maybe ConstructorReferenceId
Referent.toConstructorReferenceId Referent
ref) \(ConstructorReference Id' Hash
typeRef Word64
conId) -> do
    let f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames)
        f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames)
f = \case
          Maybe (Name, ConstructorNames)
Nothing -> do
            m () -> MaybeT m ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (OnIncoherentDeclReasons m
callbacks.onStrayConstructor Id' Hash
typeRef Name
conName)
            m (Maybe (Name, ConstructorNames))
-> MaybeT m (Name, ConstructorNames)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (Name, ConstructorNames)
-> m (Maybe (Name, ConstructorNames))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Name, ConstructorNames)
forall a. Maybe a
Nothing)
          Just (Name
typeName, ConstructorNames
expected) ->
            case HasCallStack =>
Word64 -> Name -> ConstructorNames -> Either Name ConstructorNames
Word64 -> Name -> ConstructorNames -> Either Name ConstructorNames
recordConstructorName Word64
conId Name
conName ConstructorNames
expected of
              Left Name
existingName -> do
                m () -> MaybeT m ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (OnIncoherentDeclReasons m
callbacks.onConstructorAlias Name
typeName Name
existingName Name
conName)
                m (Maybe (Name, ConstructorNames))
-> MaybeT m (Name, ConstructorNames)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (Name, ConstructorNames)
-> m (Maybe (Name, ConstructorNames))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Name, ConstructorNames)
forall a. Maybe a
Nothing)
              Right ConstructorNames
expected1 -> (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames)
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
typeName, ConstructorNames
expected1)
          where
            conName :: Name
conName =
              NonEmpty NameSegment -> Name
Name.fromReverseSegments (NameSegment
segment NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| [NameSegment]
prefix)
    DeclCoherencyCheckState
state <- StateT DeclCoherencyCheckState m DeclCoherencyCheckState
forall s (m :: * -> *). MonadState s m => m s
State.get
    StateT
  DeclCoherencyCheckState
  m
  (Maybe (Map (Id' Hash) (Name, ConstructorNames)))
-> (Map (Id' Hash) (Name, ConstructorNames)
    -> StateT DeclCoherencyCheckState m ())
-> StateT DeclCoherencyCheckState m ()
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM (m (Maybe (Map (Id' Hash) (Name, ConstructorNames)))
-> StateT
     DeclCoherencyCheckState
     m
     (Maybe (Map (Id' Hash) (Name, ConstructorNames)))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT DeclCoherencyCheckState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MaybeT m (Map (Id' Hash) (Name, ConstructorNames))
-> m (Maybe (Map (Id' Hash) (Name, ConstructorNames)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT ((Maybe (Name, ConstructorNames)
 -> MaybeT m (Name, ConstructorNames))
-> Id' Hash
-> Map (Id' Hash) (Name, ConstructorNames)
-> MaybeT m (Map (Id' Hash) (Name, ConstructorNames))
forall (f :: * -> *) k v.
(Functor f, Ord k) =>
(Maybe v -> f v) -> k -> Map k v -> f (Map k v)
Map.upsertF Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames)
f Id' Hash
typeRef DeclCoherencyCheckState
state.expectedConstructors))) \Map (Id' Hash) (Name, ConstructorNames)
expectedConstructors1 ->
      #expectedConstructors .= expectedConstructors1

checkDeclCoherencyWith_DoTypes ::
  forall m.
  (Monad m) =>
  (TypeReferenceId -> m Int) ->
  OnIncoherentDeclReasons m ->
  ( [NameSegment] ->
    (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
    StateT DeclCoherencyCheckState m ()
  ) ->
  [NameSegment] ->
  Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
  (NameSegment, TypeReference) ->
  StateT DeclCoherencyCheckState m (Maybe NameSegment)
checkDeclCoherencyWith_DoTypes :: forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> ([NameSegment]
    -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> StateT DeclCoherencyCheckState m ())
-> [NameSegment]
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> (NameSegment, TypeReference)
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
checkDeclCoherencyWith_DoTypes Id' Hash -> m Int
loadDeclNumConstructors OnIncoherentDeclReasons m
callbacks [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT DeclCoherencyCheckState m ()
go [NameSegment]
prefix Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children (NameSegment
name, TypeReference
ref) =
  case TypeReference -> Maybe (Id' Hash)
Reference.toId TypeReference
ref of
    Maybe (Id' Hash)
Nothing -> Maybe NameSegment
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
forall a. a -> StateT DeclCoherencyCheckState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NameSegment
forall a. Maybe a
Nothing
    Just Id' Hash
refId ->
      (Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> ([NameSegment]
    -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> StateT DeclCoherencyCheckState m ())
-> [NameSegment]
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> NameSegment
-> Id' Hash
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> ([NameSegment]
    -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> StateT DeclCoherencyCheckState m ())
-> [NameSegment]
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> NameSegment
-> Id' Hash
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
checkDeclCoherencyWith_DoTypes2 Id' Hash -> m Int
loadDeclNumConstructors OnIncoherentDeclReasons m
callbacks [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT DeclCoherencyCheckState m ()
go [NameSegment]
prefix Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children NameSegment
name Id' Hash
refId

checkDeclCoherencyWith_DoTypes2 ::
  forall m.
  (Monad m) =>
  (TypeReferenceId -> m Int) ->
  OnIncoherentDeclReasons m ->
  ( [NameSegment] ->
    (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
    StateT DeclCoherencyCheckState m ()
  ) ->
  [NameSegment] ->
  Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
  NameSegment ->
  TypeReferenceId ->
  StateT DeclCoherencyCheckState m (Maybe NameSegment)
checkDeclCoherencyWith_DoTypes2 :: forall (m :: * -> *).
Monad m =>
(Id' Hash -> m Int)
-> OnIncoherentDeclReasons m
-> ([NameSegment]
    -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> StateT DeclCoherencyCheckState m ())
-> [NameSegment]
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> NameSegment
-> Id' Hash
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
checkDeclCoherencyWith_DoTypes2 Id' Hash -> m Int
loadDeclNumConstructors OnIncoherentDeclReasons m
callbacks [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> StateT DeclCoherencyCheckState m ()
go [NameSegment]
prefix Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children NameSegment
name Id' Hash
typeRef = do
  DeclCoherencyCheckState
state <- StateT DeclCoherencyCheckState m DeclCoherencyCheckState
forall s (m :: * -> *). MonadState s m => m s
State.get
  m (Maybe (WhatHappened (Map (Id' Hash) (Name, ConstructorNames))))
-> StateT
     DeclCoherencyCheckState
     m
     (Maybe (WhatHappened (Map (Id' Hash) (Name, ConstructorNames))))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT DeclCoherencyCheckState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MaybeT m (WhatHappened (Map (Id' Hash) (Name, ConstructorNames)))
-> m (Maybe
        (WhatHappened (Map (Id' Hash) (Name, ConstructorNames))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Compose
  (MaybeT m) WhatHappened (Map (Id' Hash) (Name, ConstructorNames))
-> MaybeT
     m (WhatHappened (Map (Id' Hash) (Name, ConstructorNames)))
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose ((Maybe (Name, ConstructorNames)
 -> Compose (MaybeT m) WhatHappened (Name, ConstructorNames))
-> Id' Hash
-> Map (Id' Hash) (Name, ConstructorNames)
-> Compose
     (MaybeT m) WhatHappened (Map (Id' Hash) (Name, ConstructorNames))
forall (f :: * -> *) k v.
(Functor f, Ord k) =>
(Maybe v -> f v) -> k -> Map k v -> f (Map k v)
Map.upsertF Maybe (Name, ConstructorNames)
-> Compose (MaybeT m) WhatHappened (Name, ConstructorNames)
recordNewDecl Id' Hash
typeRef DeclCoherencyCheckState
state.expectedConstructors))) StateT
  DeclCoherencyCheckState
  m
  (Maybe (WhatHappened (Map (Id' Hash) (Name, ConstructorNames))))
-> (Maybe (WhatHappened (Map (Id' Hash) (Name, ConstructorNames)))
    -> StateT DeclCoherencyCheckState m (Maybe NameSegment))
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
forall a b.
StateT DeclCoherencyCheckState m a
-> (a -> StateT DeclCoherencyCheckState m b)
-> StateT DeclCoherencyCheckState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (WhatHappened (Map (Id' Hash) (Name, ConstructorNames)))
Nothing -> Maybe NameSegment
-> StateT DeclCoherencyCheckState m (Maybe NameSegment)
forall a. a -> StateT DeclCoherencyCheckState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NameSegment
forall a. Maybe a
Nothing
    Just WhatHappened (Map (Id' Hash) (Name, ConstructorNames))
UninhabitedDecl -> do
      #declNameLookup . #declToConstructors %= Map.insert typeName []
      pure Nothing
    Just (InhabitedDecl Map (Id' Hash) (Name, ConstructorNames)
expectedConstructors1) -> do
      case NameSegment
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Maybe
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
name Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children of
        Maybe (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
Nothing -> do
          m () -> StateT DeclCoherencyCheckState m ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT DeclCoherencyCheckState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (OnIncoherentDeclReasons m
callbacks.onMissingConstructorName Name
typeName)
          pure Maybe NameSegment
forall a. Maybe a
Nothing
        Just Nametree (DefnsF (Map NameSegment) Referent TypeReference)
child -> do
          #expectedConstructors .= expectedConstructors1
          go (name : prefix) child
          state <- State.get
          -- fromJust is safe here because we upserted `typeRef` key above
          let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) =
                Map.deleteLookup typeRef state.expectedConstructors
          #expectedConstructors .= expectedConstructors1
          case sequence (IntMap.elems maybeConstructorNames) of
            Nothing -> lift (callbacks.onMissingConstructorName typeName)
            Just constructorNames -> do
              #declNameLookup . #constructorToDecl %= \constructorToDecl ->
                List.foldl'
                  (\acc constructorName -> Map.insert constructorName typeName acc)
                  constructorToDecl
                  constructorNames
              #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames
          pure (Just name)
  where
    typeName :: Name
    typeName :: Name
typeName =
      NonEmpty NameSegment -> Name
Name.fromReverseSegments (NameSegment
name NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| [NameSegment]
prefix)

    recordNewDecl :: Maybe (Name, ConstructorNames) -> Compose (MaybeT m) WhatHappened (Name, ConstructorNames)
    recordNewDecl :: Maybe (Name, ConstructorNames)
-> Compose (MaybeT m) WhatHappened (Name, ConstructorNames)
recordNewDecl =
      MaybeT m (WhatHappened (Name, ConstructorNames))
-> Compose (MaybeT m) WhatHappened (Name, ConstructorNames)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MaybeT m (WhatHappened (Name, ConstructorNames))
 -> Compose (MaybeT m) WhatHappened (Name, ConstructorNames))
-> (Maybe (Name, ConstructorNames)
    -> MaybeT m (WhatHappened (Name, ConstructorNames)))
-> Maybe (Name, ConstructorNames)
-> Compose (MaybeT m) WhatHappened (Name, ConstructorNames)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Just (Name
shorterTypeName, ConstructorNames
_) -> do
          m () -> MaybeT m ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (OnIncoherentDeclReasons m
callbacks.onNestedDeclAlias Name
shorterTypeName Name
typeName)
          m (Maybe (WhatHappened (Name, ConstructorNames)))
-> MaybeT m (WhatHappened (Name, ConstructorNames))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (WhatHappened (Name, ConstructorNames))
-> m (Maybe (WhatHappened (Name, ConstructorNames)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (WhatHappened (Name, ConstructorNames))
forall a. Maybe a
Nothing)
        Maybe (Name, ConstructorNames)
Nothing ->
          m Int -> MaybeT m Int
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Id' Hash -> m Int
loadDeclNumConstructors Id' Hash
typeRef) MaybeT m Int
-> (Int -> WhatHappened (Name, ConstructorNames))
-> MaybeT m (WhatHappened (Name, ConstructorNames))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Int
0 -> WhatHappened (Name, ConstructorNames)
forall a. WhatHappened a
UninhabitedDecl
            Int
n -> (Name, ConstructorNames) -> WhatHappened (Name, ConstructorNames)
forall a. a -> WhatHappened a
InhabitedDecl (Name
typeName, Int -> ConstructorNames
emptyConstructorNames Int
n)

-- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup,
-- which doesn't require a name for every constructor, and allows a constructor with a nameless decl.
--
-- This function exists merely to extract a best-effort name mapping for the LCA of a merge. We require Alice and Bob to
-- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it
-- does, we still need to compute *some* syntactic hash for its decls.
lenientCheckDeclCoherency ::
  Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
  Map TypeReferenceId Int ->
  PartialDeclNameLookup
lenientCheckDeclCoherency :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Map (Id' Hash) Int -> PartialDeclNameLookup
lenientCheckDeclCoherency Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree Map (Id' Hash) Int
numConstructorsById =
  Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree
    Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)
    -> State LenientDeclCoherencyCheckState ())
-> State LenientDeclCoherencyCheckState ()
forall a b. a -> (a -> b) -> b
& [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> State LenientDeclCoherencyCheckState ()
go []
    State LenientDeclCoherencyCheckState ()
-> (State LenientDeclCoherencyCheckState ()
    -> LenientDeclCoherencyCheckState)
-> LenientDeclCoherencyCheckState
forall a b. a -> (a -> b) -> b
& (State LenientDeclCoherencyCheckState ()
-> LenientDeclCoherencyCheckState -> LenientDeclCoherencyCheckState
forall s a. State s a -> s -> s
`State.execState` Map (Id' Hash) (Map Name ConstructorNames)
-> PartialDeclNameLookup -> LenientDeclCoherencyCheckState
LenientDeclCoherencyCheckState Map (Id' Hash) (Map Name ConstructorNames)
forall k a. Map k a
Map.empty (Map Name Name -> Map Name [Maybe Name] -> PartialDeclNameLookup
PartialDeclNameLookup Map Name Name
forall k a. Map k a
Map.empty Map Name [Maybe Name]
forall k a. Map k a
Map.empty))
    LenientDeclCoherencyCheckState
-> (LenientDeclCoherencyCheckState -> PartialDeclNameLookup)
-> PartialDeclNameLookup
forall a b. a -> (a -> b) -> b
& Getting
  PartialDeclNameLookup
  LenientDeclCoherencyCheckState
  PartialDeclNameLookup
-> LenientDeclCoherencyCheckState -> PartialDeclNameLookup
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  PartialDeclNameLookup
  LenientDeclCoherencyCheckState
  PartialDeclNameLookup
#declNameLookup
  where
    go ::
      [NameSegment] ->
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
      State LenientDeclCoherencyCheckState ()
    go :: [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> State LenientDeclCoherencyCheckState ()
go [NameSegment]
prefix (Nametree DefnsF (Map NameSegment) Referent TypeReference
defns Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children) = do
      [(NameSegment, Referent)]
-> ((NameSegment, Referent)
    -> State LenientDeclCoherencyCheckState ())
-> State LenientDeclCoherencyCheckState ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map NameSegment Referent -> [(NameSegment, Referent)]
forall k a. Map k a -> [(k, a)]
Map.toList DefnsF (Map NameSegment) Referent TypeReference
defns.terms) \case
        (NameSegment
_, Referent.Ref TypeReference
_) -> () -> State LenientDeclCoherencyCheckState ()
forall a. a -> StateT LenientDeclCoherencyCheckState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (NameSegment
_, Referent.Con (ConstructorReference (ReferenceBuiltin Text
_) Word64
_) ConstructorType
_) -> () -> State LenientDeclCoherencyCheckState ()
forall a. a -> StateT LenientDeclCoherencyCheckState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (NameSegment
name, Referent.Con (ConstructorReference (ReferenceDerived Id' Hash
typeRef) Word64
conId) ConstructorType
_) -> do
          #expectedConstructors %= Map.adjust (Map.map (lenientRecordConstructorName conId (fullName name))) typeRef

      [NameSegment]
childrenWeWentInto <-
        [(NameSegment, TypeReference)]
-> ((NameSegment, TypeReference)
    -> StateT
         LenientDeclCoherencyCheckState Identity (Maybe NameSegment))
-> StateT LenientDeclCoherencyCheckState Identity [NameSegment]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe (Map NameSegment TypeReference -> [(NameSegment, TypeReference)]
forall k a. Map k a -> [(k, a)]
Map.toList DefnsF (Map NameSegment) Referent TypeReference
defns.types) \case
          (NameSegment
_, ReferenceBuiltin Text
_) -> Maybe NameSegment
-> StateT
     LenientDeclCoherencyCheckState Identity (Maybe NameSegment)
forall a. a -> StateT LenientDeclCoherencyCheckState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NameSegment
forall a. Maybe a
Nothing
          (NameSegment
name, ReferenceDerived Id' Hash
typeRef) -> do
            LenientDeclCoherencyCheckState
state <- StateT
  LenientDeclCoherencyCheckState
  Identity
  LenientDeclCoherencyCheckState
forall s (m :: * -> *). MonadState s m => m s
State.get
            let whatHappened :: WhatHappened (Map (Id' Hash) (Map Name ConstructorNames))
whatHappened =
                  let recordNewDecl :: WhatHappened (Map Name ConstructorNames)
                      recordNewDecl :: WhatHappened (Map Name ConstructorNames)
recordNewDecl =
                        case HasCallStack => Id' Hash -> Map (Id' Hash) Int -> Int
Id' Hash -> Map (Id' Hash) Int -> Int
expectNumConstructors Id' Hash
typeRef Map (Id' Hash) Int
numConstructorsById of
                          Int
0 -> WhatHappened (Map Name ConstructorNames)
forall a. WhatHappened a
UninhabitedDecl
                          Int
n -> Map Name ConstructorNames
-> WhatHappened (Map Name ConstructorNames)
forall a. a -> WhatHappened a
InhabitedDecl (Name -> ConstructorNames -> Map Name ConstructorNames
forall k a. k -> a -> Map k a
Map.singleton Name
typeName (Int -> ConstructorNames
emptyConstructorNames Int
n))
                   in (Maybe (Map Name ConstructorNames)
 -> WhatHappened (Map Name ConstructorNames))
-> Id' Hash
-> Map (Id' Hash) (Map Name ConstructorNames)
-> WhatHappened (Map (Id' Hash) (Map Name ConstructorNames))
forall (f :: * -> *) k v.
(Functor f, Ord k) =>
(Maybe v -> f v) -> k -> Map k v -> f (Map k v)
Map.upsertF (\Maybe (Map Name ConstructorNames)
_ -> WhatHappened (Map Name ConstructorNames)
recordNewDecl) Id' Hash
typeRef LenientDeclCoherencyCheckState
state.expectedConstructors
            case WhatHappened (Map (Id' Hash) (Map Name ConstructorNames))
whatHappened of
              WhatHappened (Map (Id' Hash) (Map Name ConstructorNames))
UninhabitedDecl -> do
                #declNameLookup . #declToConstructors %= Map.insert typeName []
                pure Nothing
              InhabitedDecl Map (Id' Hash) (Map Name ConstructorNames)
expectedConstructors1 -> do
                let child :: Nametree (DefnsF (Map NameSegment) Referent TypeReference)
child = Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> NameSegment
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (DefnsF (Map NameSegment) Referent TypeReference
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
forall a. a -> Map NameSegment (Nametree a) -> Nametree a
Nametree (Map NameSegment Referent
-> Map NameSegment TypeReference
-> DefnsF (Map NameSegment) Referent TypeReference
forall terms types. terms -> types -> Defns terms types
Defns Map NameSegment Referent
forall k a. Map k a
Map.empty Map NameSegment TypeReference
forall k a. Map k a
Map.empty) Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall k a. Map k a
Map.empty) NameSegment
name Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children
                #expectedConstructors .= expectedConstructors1
                [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> State LenientDeclCoherencyCheckState ()
go (NameSegment
name NameSegment -> [NameSegment] -> [NameSegment]
forall a. a -> [a] -> [a]
: [NameSegment]
prefix) Nametree (DefnsF (Map NameSegment) Referent TypeReference)
child
                LenientDeclCoherencyCheckState
state <- StateT
  LenientDeclCoherencyCheckState
  Identity
  LenientDeclCoherencyCheckState
forall s (m :: * -> *). MonadState s m => m s
State.get
                let (ConstructorNames
constructorNames0, Map (Id' Hash) (Map Name ConstructorNames)
expectedConstructors) =
                      (Maybe (Map Name ConstructorNames)
 -> (ConstructorNames, Maybe (Map Name ConstructorNames)))
-> Id' Hash
-> Map (Id' Hash) (Map Name ConstructorNames)
-> (ConstructorNames, Map (Id' Hash) (Map Name ConstructorNames))
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe (Map Name ConstructorNames)
-> (ConstructorNames, Maybe (Map Name ConstructorNames))
f Id' Hash
typeRef LenientDeclCoherencyCheckState
state.expectedConstructors
                      where
                        f ::
                          Maybe (Map Name ConstructorNames) ->
                          (ConstructorNames, Maybe (Map Name ConstructorNames))
                        f :: Maybe (Map Name ConstructorNames)
-> (ConstructorNames, Maybe (Map Name ConstructorNames))
f =
                          -- fromJust is safe here because we upserted `typeRef` key above
                          -- deleteLookupJust is safe here because we upserted `typeName` key above
                          Maybe (Map Name ConstructorNames) -> Map Name ConstructorNames
forall a. HasCallStack => Maybe a -> a
fromJust
                            (Maybe (Map Name ConstructorNames) -> Map Name ConstructorNames)
-> (Map Name ConstructorNames
    -> (ConstructorNames, Maybe (Map Name ConstructorNames)))
-> Maybe (Map Name ConstructorNames)
-> (ConstructorNames, Maybe (Map Name ConstructorNames))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Name
-> Map Name ConstructorNames
-> (ConstructorNames, Map Name ConstructorNames)
forall k v. (HasCallStack, Ord k) => k -> Map k v -> (v, Map k v)
Map.deleteLookupJust Name
typeName
                            (Map Name ConstructorNames
 -> (ConstructorNames, Map Name ConstructorNames))
-> ((ConstructorNames, Map Name ConstructorNames)
    -> (ConstructorNames, Maybe (Map Name ConstructorNames)))
-> Map Name ConstructorNames
-> (ConstructorNames, Maybe (Map Name ConstructorNames))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ASetter
  (ConstructorNames, Map Name ConstructorNames)
  (ConstructorNames, Maybe (Map Name ConstructorNames))
  (Map Name ConstructorNames)
  (Maybe (Map Name ConstructorNames))
-> (Map Name ConstructorNames -> Maybe (Map Name ConstructorNames))
-> (ConstructorNames, Map Name ConstructorNames)
-> (ConstructorNames, Maybe (Map Name ConstructorNames))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ConstructorNames, Map Name ConstructorNames)
  (ConstructorNames, Maybe (Map Name ConstructorNames))
  (Map Name ConstructorNames)
  (Maybe (Map Name ConstructorNames))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (ConstructorNames, Map Name ConstructorNames)
  (ConstructorNames, Maybe (Map Name ConstructorNames))
  (Map Name ConstructorNames)
  (Maybe (Map Name ConstructorNames))
_2 \Map Name ConstructorNames
m -> if Map Name ConstructorNames -> Bool
forall k a. Map k a -> Bool
Map.null Map Name ConstructorNames
m then Maybe (Map Name ConstructorNames)
forall a. Maybe a
Nothing else Map Name ConstructorNames -> Maybe (Map Name ConstructorNames)
forall a. a -> Maybe a
Just Map Name ConstructorNames
m

                    constructorNames :: [Maybe Name]
                    constructorNames :: [Maybe Name]
constructorNames =
                      ConstructorNames -> [Maybe Name]
forall a. IntMap a -> [a]
IntMap.elems ConstructorNames
constructorNames0

                #expectedConstructors .= expectedConstructors
                #declNameLookup . #constructorToDecl %= \constructorToDecl ->
                  List.foldl'
                    ( \acc -> \case
                        Nothing -> acc
                        Just constructorName -> Map.insert constructorName typeName acc
                    )
                    constructorToDecl
                    constructorNames
                #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames
                pure (NameSegment -> Maybe NameSegment
forall a. a -> Maybe a
Just NameSegment
name)
            where
              typeName :: Name
typeName = NameSegment -> Name
fullName NameSegment
name

      let childrenWeHaventGoneInto :: Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
childrenWeHaventGoneInto = Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
children Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Set NameSegment
-> Map
     NameSegment
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` [NameSegment] -> Set NameSegment
forall a. Ord a => [a] -> Set a
Set.fromList [NameSegment]
childrenWeWentInto
      [(NameSegment,
  Nametree (DefnsF (Map NameSegment) Referent TypeReference))]
-> ((NameSegment,
     Nametree (DefnsF (Map NameSegment) Referent TypeReference))
    -> State LenientDeclCoherencyCheckState ())
-> State LenientDeclCoherencyCheckState ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> [(NameSegment,
     Nametree (DefnsF (Map NameSegment) Referent TypeReference))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  NameSegment
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
childrenWeHaventGoneInto) \(NameSegment
name, Nametree (DefnsF (Map NameSegment) Referent TypeReference)
child) -> [NameSegment]
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> State LenientDeclCoherencyCheckState ()
go (NameSegment
name NameSegment -> [NameSegment] -> [NameSegment]
forall a. a -> [a] -> [a]
: [NameSegment]
prefix) Nametree (DefnsF (Map NameSegment) Referent TypeReference)
child
      where
        fullName :: NameSegment -> Name
fullName NameSegment
name =
          NonEmpty NameSegment -> Name
Name.fromReverseSegments (NameSegment
name NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| [NameSegment]
prefix)

data DeclCoherencyCheckState = DeclCoherencyCheckState
  { DeclCoherencyCheckState -> Map (Id' Hash) (Name, ConstructorNames)
expectedConstructors :: !(Map TypeReferenceId (Name, ConstructorNames)),
    DeclCoherencyCheckState -> DeclNameLookup
declNameLookup :: !DeclNameLookup
  }
  deriving stock ((forall x.
 DeclCoherencyCheckState -> Rep DeclCoherencyCheckState x)
-> (forall x.
    Rep DeclCoherencyCheckState x -> DeclCoherencyCheckState)
-> Generic DeclCoherencyCheckState
forall x. Rep DeclCoherencyCheckState x -> DeclCoherencyCheckState
forall x. DeclCoherencyCheckState -> Rep DeclCoherencyCheckState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeclCoherencyCheckState -> Rep DeclCoherencyCheckState x
from :: forall x. DeclCoherencyCheckState -> Rep DeclCoherencyCheckState x
$cto :: forall x. Rep DeclCoherencyCheckState x -> DeclCoherencyCheckState
to :: forall x. Rep DeclCoherencyCheckState x -> DeclCoherencyCheckState
Generic)

data LenientDeclCoherencyCheckState = LenientDeclCoherencyCheckState
  { LenientDeclCoherencyCheckState
-> Map (Id' Hash) (Map Name ConstructorNames)
expectedConstructors :: !(Map TypeReferenceId (Map Name ConstructorNames)),
    LenientDeclCoherencyCheckState -> PartialDeclNameLookup
declNameLookup :: !PartialDeclNameLookup
  }
  deriving stock ((forall x.
 LenientDeclCoherencyCheckState
 -> Rep LenientDeclCoherencyCheckState x)
-> (forall x.
    Rep LenientDeclCoherencyCheckState x
    -> LenientDeclCoherencyCheckState)
-> Generic LenientDeclCoherencyCheckState
forall x.
Rep LenientDeclCoherencyCheckState x
-> LenientDeclCoherencyCheckState
forall x.
LenientDeclCoherencyCheckState
-> Rep LenientDeclCoherencyCheckState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LenientDeclCoherencyCheckState
-> Rep LenientDeclCoherencyCheckState x
from :: forall x.
LenientDeclCoherencyCheckState
-> Rep LenientDeclCoherencyCheckState x
$cto :: forall x.
Rep LenientDeclCoherencyCheckState x
-> LenientDeclCoherencyCheckState
to :: forall x.
Rep LenientDeclCoherencyCheckState x
-> LenientDeclCoherencyCheckState
Generic)

-- A partial mapping from constructor id to name; a collection of constructor names starts out with the correct number
-- of keys (per the number of data constructors) all mapped to Nothing. Then, as names are discovered by walking a
-- name tree, Nothings become Justs.
type ConstructorNames =
  IntMap (Maybe Name)

-- Make an empty set of constructor names given the number of constructors.
emptyConstructorNames :: Int -> ConstructorNames
emptyConstructorNames :: Int -> ConstructorNames
emptyConstructorNames Int
numConstructors =
  [(Int, Maybe Name)] -> ConstructorNames
forall a. [(Int, a)] -> IntMap a
IntMap.fromAscList [(Int
i, Maybe Name
forall a. Maybe a
Nothing) | Int
i <- [Int
0 .. Int
numConstructors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

recordConstructorName :: (HasCallStack) => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames
recordConstructorName :: HasCallStack =>
Word64 -> Name -> ConstructorNames -> Either Name ConstructorNames
recordConstructorName Word64
conId Name
conName =
  (Maybe (Maybe Name) -> Either Name (Maybe (Maybe Name)))
-> Int -> ConstructorNames -> Either Name ConstructorNames
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe (Maybe Name) -> Either Name (Maybe (Maybe Name))
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int Word64
conId)
  where
    f :: Maybe (Maybe Name) -> Either Name (Maybe (Maybe Name))
    f :: Maybe (Maybe Name) -> Either Name (Maybe (Maybe Name))
f = \case
      Maybe (Maybe Name)
Nothing -> String -> Either Name (Maybe (Maybe Name))
forall a. HasCallStack => String -> a
error (String -> ShowS
reportBug String
"E397219" (String
"recordConstructorName: didn't expect constructor id " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
conId))
      Just Maybe Name
Nothing -> Maybe (Maybe Name) -> Either Name (Maybe (Maybe Name))
forall a b. b -> Either a b
Right (Maybe Name -> Maybe (Maybe Name)
forall a. a -> Maybe a
Just (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
conName))
      Just (Just Name
existingName) -> Name -> Either Name (Maybe (Maybe Name))
forall a b. a -> Either a b
Left Name
existingName

lenientRecordConstructorName :: ConstructorId -> Name -> ConstructorNames -> ConstructorNames
lenientRecordConstructorName :: Word64 -> Name -> ConstructorNames -> ConstructorNames
lenientRecordConstructorName Word64
conId Name
conName =
  (Maybe Name -> Maybe Name)
-> Int -> ConstructorNames -> ConstructorNames
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IntMap.adjust Maybe Name -> Maybe Name
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int Word64
conId)
  where
    f :: Maybe Name -> Maybe Name
    f :: Maybe Name -> Maybe Name
f = \case
      Maybe Name
Nothing -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
conName
      -- Ignore constructor alias, just keep first name we found
      Just Name
existingName -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
existingName

data WhatHappened a
  = UninhabitedDecl
  | InhabitedDecl !a
  deriving stock ((forall a b. (a -> b) -> WhatHappened a -> WhatHappened b)
-> (forall a b. a -> WhatHappened b -> WhatHappened a)
-> Functor WhatHappened
forall a b. a -> WhatHappened b -> WhatHappened a
forall a b. (a -> b) -> WhatHappened a -> WhatHappened b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WhatHappened a -> WhatHappened b
fmap :: forall a b. (a -> b) -> WhatHappened a -> WhatHappened b
$c<$ :: forall a b. a -> WhatHappened b -> WhatHappened a
<$ :: forall a b. a -> WhatHappened b -> WhatHappened a
Functor, Int -> WhatHappened a -> ShowS
[WhatHappened a] -> ShowS
WhatHappened a -> String
(Int -> WhatHappened a -> ShowS)
-> (WhatHappened a -> String)
-> ([WhatHappened a] -> ShowS)
-> Show (WhatHappened a)
forall a. Show a => Int -> WhatHappened a -> ShowS
forall a. Show a => [WhatHappened a] -> ShowS
forall a. Show a => WhatHappened a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WhatHappened a -> ShowS
showsPrec :: Int -> WhatHappened a -> ShowS
$cshow :: forall a. Show a => WhatHappened a -> String
show :: WhatHappened a -> String
$cshowList :: forall a. Show a => [WhatHappened a] -> ShowS
showList :: [WhatHappened a] -> ShowS
Show)

expectNumConstructors :: (HasCallStack) => TypeReferenceId -> Map TypeReferenceId Int -> Int
expectNumConstructors :: HasCallStack => Id' Hash -> Map (Id' Hash) Int -> Int
expectNumConstructors Id' Hash
refId Map (Id' Hash) Int
numConstructorsById =
  case Id' Hash -> Map (Id' Hash) Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id' Hash
refId Map (Id' Hash) Int
numConstructorsById of
    Just Int
numConstructors -> Int
numConstructors
    Maybe Int
Nothing ->
      String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
reportBug String
"E061715" (String
"type ref " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id' Hash -> String
forall a. Show a => a -> String
show Id' Hash
refId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found in map " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map (Id' Hash) Int -> String
forall a. Show a => a -> String
show Map (Id' Hash) Int
numConstructorsById)