module Unison.DeclNameLookup
  ( DeclNameLookup (..),
    expectDeclName,
    expectConstructorNames,
  )
where

import Data.Map.Strict qualified as Map
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Unison.Name (Name)
import Unison.Prelude

-- | A lookup from decl-to-constructor name and vice-versa.
--
-- For example, a type decl like
--
-- @
-- unique type Foo
--   = Bar Int
--   | Baz.Qux Nat Nat
-- @
--
-- is represented as
--
-- @
-- DeclNameLookup
--   { constructorToDecl = Map.fromList [("Foo.Bar", "Foo"), ("Foo.Baz.Qux", "Foo")]
--   , declToConstructors = Map.fromList [("Foo", ["Foo.Bar", "Foo.Baz.Qux"])]
--   }
-- @
--
-- Note that:
--
-- * Constructor names are given "in full", though they will all necessarily begin with the decl's name.
-- * In @declToConstructors@, the constructor names are given in their canonical ordering.
data DeclNameLookup = DeclNameLookup
  { DeclNameLookup -> Map Name Name
constructorToDecl :: !(Map Name Name),
    DeclNameLookup -> Map Name [Name]
declToConstructors :: !(Map Name [Name])
  }
  deriving stock ((forall x. DeclNameLookup -> Rep DeclNameLookup x)
-> (forall x. Rep DeclNameLookup x -> DeclNameLookup)
-> Generic DeclNameLookup
forall x. Rep DeclNameLookup x -> DeclNameLookup
forall x. DeclNameLookup -> Rep DeclNameLookup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeclNameLookup -> Rep DeclNameLookup x
from :: forall x. DeclNameLookup -> Rep DeclNameLookup x
$cto :: forall x. Rep DeclNameLookup x -> DeclNameLookup
to :: forall x. Rep DeclNameLookup x -> DeclNameLookup
Generic)
  deriving (NonEmpty DeclNameLookup -> DeclNameLookup
DeclNameLookup -> DeclNameLookup -> DeclNameLookup
(DeclNameLookup -> DeclNameLookup -> DeclNameLookup)
-> (NonEmpty DeclNameLookup -> DeclNameLookup)
-> (forall b. Integral b => b -> DeclNameLookup -> DeclNameLookup)
-> Semigroup DeclNameLookup
forall b. Integral b => b -> DeclNameLookup -> DeclNameLookup
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: DeclNameLookup -> DeclNameLookup -> DeclNameLookup
<> :: DeclNameLookup -> DeclNameLookup -> DeclNameLookup
$csconcat :: NonEmpty DeclNameLookup -> DeclNameLookup
sconcat :: NonEmpty DeclNameLookup -> DeclNameLookup
$cstimes :: forall b. Integral b => b -> DeclNameLookup -> DeclNameLookup
stimes :: forall b. Integral b => b -> DeclNameLookup -> DeclNameLookup
Semigroup) via (GenericSemigroupMonoid DeclNameLookup)

expectDeclName :: (HasCallStack) => DeclNameLookup -> Name -> Name
expectDeclName :: HasCallStack => DeclNameLookup -> Name -> Name
expectDeclName DeclNameLookup {Map Name Name
$sel:constructorToDecl:DeclNameLookup :: DeclNameLookup -> Map Name Name
constructorToDecl :: Map Name Name
constructorToDecl} Name
x =
  case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x Map Name Name
constructorToDecl of
    Maybe Name
Nothing -> String -> Name
forall a. HasCallStack => String -> a
error (String -> String -> String
reportBug String
"E246726" (String
"Expected constructor name key " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in decl name lookup"))
    Just Name
y -> Name
y

expectConstructorNames :: (HasCallStack) => DeclNameLookup -> Name -> [Name]
expectConstructorNames :: HasCallStack => DeclNameLookup -> Name -> [Name]
expectConstructorNames DeclNameLookup {Map Name [Name]
$sel:declToConstructors:DeclNameLookup :: DeclNameLookup -> Map Name [Name]
declToConstructors :: Map Name [Name]
declToConstructors} Name
x =
  case Name -> Map Name [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x Map Name [Name]
declToConstructors of
    Maybe [Name]
Nothing -> String -> [Name]
forall a. HasCallStack => String -> a
error (String -> String -> String
reportBug String
"E077058" (String
"Expected decl name key " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in decl name lookup"))
    Just [Name]
y -> [Name]
y