module Unison.PartialDeclNameLookup
  ( PartialDeclNameLookup (..),
    Unison.PartialDeclNameLookup.empty,
    expectDeclName,
    expectConstructorNames,
    toDeclNameLookup,
    fromDeclNameLookup,
  )
where

import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Unison.DeclNameLookup (DeclNameLookup (..))
import Unison.Name (Name)
import Unison.Prelude

-- | Like a @DeclNameLookup@, but "partial" / more lenient - because we don't require the LCA of a merge to have a full
-- @DeclNameLookup@.
data PartialDeclNameLookup = PartialDeclNameLookup
  { PartialDeclNameLookup -> Map Name Name
constructorToDecl :: !(Map Name Name),
    PartialDeclNameLookup -> Map Name [Maybe Name]
declToConstructors :: !(Map Name [Maybe Name])
  }
  deriving stock ((forall x. PartialDeclNameLookup -> Rep PartialDeclNameLookup x)
-> (forall x. Rep PartialDeclNameLookup x -> PartialDeclNameLookup)
-> Generic PartialDeclNameLookup
forall x. Rep PartialDeclNameLookup x -> PartialDeclNameLookup
forall x. PartialDeclNameLookup -> Rep PartialDeclNameLookup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PartialDeclNameLookup -> Rep PartialDeclNameLookup x
from :: forall x. PartialDeclNameLookup -> Rep PartialDeclNameLookup x
$cto :: forall x. Rep PartialDeclNameLookup x -> PartialDeclNameLookup
to :: forall x. Rep PartialDeclNameLookup x -> PartialDeclNameLookup
Generic)

empty :: PartialDeclNameLookup
empty :: PartialDeclNameLookup
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

expectDeclName :: (HasCallStack) => PartialDeclNameLookup -> Name -> Name
expectDeclName :: HasCallStack => PartialDeclNameLookup -> Name -> Name
expectDeclName PartialDeclNameLookup {Map Name Name
$sel:constructorToDecl:PartialDeclNameLookup :: PartialDeclNameLookup -> 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
"E874908" (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 partial decl name lookup"))
    Just Name
y -> Name
y

expectConstructorNames :: (HasCallStack) => PartialDeclNameLookup -> Name -> [Maybe Name]
expectConstructorNames :: HasCallStack => PartialDeclNameLookup -> Name -> [Maybe Name]
expectConstructorNames PartialDeclNameLookup {Map Name [Maybe Name]
$sel:declToConstructors:PartialDeclNameLookup :: PartialDeclNameLookup -> Map Name [Maybe Name]
declToConstructors :: Map Name [Maybe Name]
declToConstructors} Name
x =
  case Name -> Map Name [Maybe Name] -> Maybe [Maybe Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x Map Name [Maybe Name]
declToConstructors of
    Maybe [Maybe Name]
Nothing -> String -> [Maybe Name]
forall a. HasCallStack => String -> a
error (String -> String -> String
reportBug String
"E800097" (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 partial decl name lookup"))
    Just [Maybe Name]
y -> [Maybe Name]
y

-- | Turn a partial decl name lookup into a total decl name lookup.
--
-- This isn't very sensible, but in certain cases we do find ourselves in the unfortunate circumstance of needing to
-- render a type declaration that doesn't have a name for one or more of its constructors (as when rendering the LCA
-- file of a difftool or mergetool, since we do allow the LCA to have missing constructors).
--
-- This function just assigns bogus names like "Unnamed" for rendering.
toDeclNameLookup :: (Text -> Name) -> PartialDeclNameLookup -> DeclNameLookup
toDeclNameLookup :: (Text -> Name) -> PartialDeclNameLookup -> DeclNameLookup
toDeclNameLookup Text -> Name
unsafeParseText PartialDeclNameLookup
partialDeclNameLookup =
  DeclNameLookup
    { $sel:constructorToDecl:DeclNameLookup :: Map Name Name
constructorToDecl = PartialDeclNameLookup
partialDeclNameLookup.constructorToDecl,
      $sel:declToConstructors:DeclNameLookup :: Map Name [Name]
declToConstructors =
        [Maybe Name] -> [Name]
makeTotal ([Maybe Name] -> [Name])
-> Map Name [Maybe Name] -> Map Name [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartialDeclNameLookup
partialDeclNameLookup.declToConstructors
    }
  where
    makeTotal :: [Maybe Name] -> [Name]
    makeTotal :: [Maybe Name] -> [Name]
makeTotal [Maybe Name]
names0 =
      case [Maybe Name] -> Maybe [Name]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Maybe Name]
names0 of
        Just [Name]
names -> [Name]
names
        Maybe [Name]
Nothing ->
          (Set Name, [Name]) -> [Name]
forall a b. (a, b) -> b
snd ((Set Name, [Name]) -> [Name]) -> (Set Name, [Name]) -> [Name]
forall a b. (a -> b) -> a -> b
$
            (Set Name -> Maybe Name -> (Set Name, Name))
-> Set Name -> [Maybe Name] -> (Set Name, [Name])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
              Set Name -> Maybe Name -> (Set Name, Name)
makeSomethingUp
              ((Maybe Name -> Set Name) -> [Maybe Name] -> Set Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Set Name -> (Name -> Set Name) -> Maybe Name -> Set Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Name
forall a. Set a
Set.empty Name -> Set Name
forall a. a -> Set a
Set.singleton) [Maybe Name]
names0)
              [Maybe Name]
names0

    makeSomethingUp :: Set Name -> Maybe Name -> (Set Name, Name)
    makeSomethingUp :: Set Name -> Maybe Name -> (Set Name, Name)
makeSomethingUp Set Name
taken = \case
      Just Name
name -> (Set Name
taken, Name
name)
      Maybe Name
Nothing ->
        let name :: Name
name = Int -> Text -> Name
freshen Int
0 Text
"Unnamed"
            !taken1 :: Set Name
taken1 = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
name Set Name
taken
         in (Set Name
taken1, Name
name)
      where
        freshen :: Int -> Text -> Name
        freshen :: Int -> Text -> Name
freshen Int
i Text
name0
          | Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Name
name Set Name
taken = Int -> Text -> Name
freshen (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
name0
          | Bool
otherwise = Name
name
          where
            name :: Name
            name :: Name
name =
              Text -> Name
unsafeParseText (Text
name0 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
Text.empty else String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i))

fromDeclNameLookup :: DeclNameLookup -> PartialDeclNameLookup
fromDeclNameLookup :: DeclNameLookup -> PartialDeclNameLookup
fromDeclNameLookup DeclNameLookup
declNameLookup =
  PartialDeclNameLookup
    { $sel:constructorToDecl:PartialDeclNameLookup :: Map Name Name
constructorToDecl = DeclNameLookup
declNameLookup.constructorToDecl,
      $sel:declToConstructors:PartialDeclNameLookup :: Map Name [Maybe Name]
declToConstructors = ([Name] -> [Maybe Name])
-> Map Name [Name] -> Map Name [Maybe Name]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Name -> Maybe Name) -> [Name] -> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Maybe Name
forall a. a -> Maybe a
Just) DeclNameLookup
declNameLookup.declToConstructors
    }