{-# LANGUAGE RecordWildCards #-}

module Unison.DataDeclaration.Names
  ( bindNames,
    dataDeclToNames',
    effectDeclToNames',
  )
where

import Control.Lens (traverseOf, _3)
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration (DataDeclaration (..), EffectDeclaration)
import Unison.DataDeclaration qualified as DD
import Unison.Name (Name)
import Unison.Names (Names (Names))
import Unison.Names.ResolutionResult qualified as Names
import Unison.Prelude
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Type.Names qualified as Type.Names
import Unison.Util.Relation qualified as Rel
import Unison.Var (Var)
import Prelude hiding (cycle)

-- implementation of dataDeclToNames and effectDeclToNames
toNames :: (Var v) => (v -> Name) -> CT.ConstructorType -> v -> Reference.Id -> DataDeclaration v a -> Names
toNames :: forall v a.
Var v =>
(v -> Name)
-> ConstructorType -> v -> Id -> DataDeclaration v a -> Names
toNames v -> Name
varToName ConstructorType
ct v
typeSymbol (Id -> TypeReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId -> TypeReference
r) DataDeclaration v a
dd =
  -- constructor names
  ((v, ConstructorId) -> Names) -> [(v, ConstructorId)] -> Names
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (v, ConstructorId) -> Names
names (DataDeclaration v a -> [v]
forall v a. DataDeclaration v a -> [v]
DD.constructorVars DataDeclaration v a
dd [v] -> [ConstructorId] -> [(v, ConstructorId)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [ConstructorId
0 ..])
    -- name of the type itself
    Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
forall a. Monoid a => a
mempty (Name -> TypeReference -> Relation Name TypeReference
forall a b. a -> b -> Relation a b
Rel.singleton (v -> Name
varToName v
typeSymbol) TypeReference
r)
  where
    names :: (v, ConstructorId) -> Names
names (v
ctor, ConstructorId
i) =
      Relation Name Referent -> Relation Name TypeReference -> Names
Names (Name -> Referent -> Relation Name Referent
forall a b. a -> b -> Relation a b
Rel.singleton (v -> Name
varToName v
ctor) (ConstructorReference -> ConstructorType -> Referent
Referent.Con (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
r ConstructorId
i) ConstructorType
ct)) Relation Name TypeReference
forall a. Monoid a => a
mempty

dataDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> DataDeclaration v a -> Names
dataDeclToNames :: forall v a.
Var v =>
(v -> Name) -> v -> Id -> DataDeclaration v a -> Names
dataDeclToNames v -> Name
varToName = (v -> Name)
-> ConstructorType -> v -> Id -> DataDeclaration v a -> Names
forall v a.
Var v =>
(v -> Name)
-> ConstructorType -> v -> Id -> DataDeclaration v a -> Names
toNames v -> Name
varToName ConstructorType
CT.Data

effectDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> EffectDeclaration v a -> Names
effectDeclToNames :: forall v a.
Var v =>
(v -> Name) -> v -> Id -> EffectDeclaration v a -> Names
effectDeclToNames v -> Name
varToName v
typeSymbol Id
r EffectDeclaration v a
ed = (v -> Name)
-> ConstructorType -> v -> Id -> DataDeclaration v a -> Names
forall v a.
Var v =>
(v -> Name)
-> ConstructorType -> v -> Id -> DataDeclaration v a -> Names
toNames v -> Name
varToName ConstructorType
CT.Effect v
typeSymbol Id
r (DataDeclaration v a -> Names) -> DataDeclaration v a -> Names
forall a b. (a -> b) -> a -> b
$ EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl EffectDeclaration v a
ed

dataDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, DataDeclaration v a)) -> Names
dataDeclToNames' :: forall v a.
Var v =>
(v -> Name) -> (v, (Id, DataDeclaration v a)) -> Names
dataDeclToNames' v -> Name
varToName (v
v, (Id
r, DataDeclaration v a
d)) = (v -> Name) -> v -> Id -> DataDeclaration v a -> Names
forall v a.
Var v =>
(v -> Name) -> v -> Id -> DataDeclaration v a -> Names
dataDeclToNames v -> Name
varToName v
v Id
r DataDeclaration v a
d

effectDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, EffectDeclaration v a)) -> Names
effectDeclToNames' :: forall v a.
Var v =>
(v -> Name) -> (v, (Id, EffectDeclaration v a)) -> Names
effectDeclToNames' v -> Name
varToName (v
v, (Id
r, EffectDeclaration v a
d)) = (v -> Name) -> v -> Id -> EffectDeclaration v a -> Names
forall v a.
Var v =>
(v -> Name) -> v -> Id -> EffectDeclaration v a -> Names
effectDeclToNames v -> Name
varToName v
v Id
r EffectDeclaration v a
d

bindNames ::
  (Var v) =>
  (v -> Name) ->
  (Name -> v) ->
  Set v ->
  Names ->
  DataDeclaration v a ->
  Names.ResolutionResult a (DataDeclaration v a)
bindNames :: forall v a.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> DataDeclaration v a
-> ResolutionResult a (DataDeclaration v a)
bindNames v -> Name
unsafeVarToName Name -> v
nameToVar Set v
localNames Names
namespaceNames =
  LensLike
  (Either (Seq (ResolutionFailure a)))
  (DataDeclaration v a)
  (DataDeclaration v a)
  (Type v a)
  (Type v a)
-> LensLike
     (Either (Seq (ResolutionFailure a)))
     (DataDeclaration v a)
     (DataDeclaration v a)
     (Type v a)
     (Type v a)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (([(a, v, Type v a)]
 -> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)])
-> DataDeclaration v a
-> Either (Seq (ResolutionFailure a)) (DataDeclaration v a)
#constructors' (([(a, v, Type v a)]
  -> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)])
 -> DataDeclaration v a
 -> Either (Seq (ResolutionFailure a)) (DataDeclaration v a))
-> ((Type v a -> Either (Seq (ResolutionFailure a)) (Type v a))
    -> [(a, v, Type v a)]
    -> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)])
-> LensLike
     (Either (Seq (ResolutionFailure a)))
     (DataDeclaration v a)
     (DataDeclaration v a)
     (Type v a)
     (Type v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, v, Type v a)
 -> Either (Seq (ResolutionFailure a)) (a, v, Type v a))
-> [(a, v, Type v a)]
-> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)]
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) -> [a] -> f [b]
traverse (((a, v, Type v a)
  -> Either (Seq (ResolutionFailure a)) (a, v, Type v a))
 -> [(a, v, Type v a)]
 -> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)])
-> ((Type v a -> Either (Seq (ResolutionFailure a)) (Type v a))
    -> (a, v, Type v a)
    -> Either (Seq (ResolutionFailure a)) (a, v, Type v a))
-> (Type v a -> Either (Seq (ResolutionFailure a)) (Type v a))
-> [(a, v, Type v a)]
-> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type v a -> Either (Seq (ResolutionFailure a)) (Type v a))
-> (a, v, Type v a)
-> Either (Seq (ResolutionFailure a)) (a, v, Type v a)
forall s t a b. Field3 s t a b => Lens s t a b
Lens (a, v, Type v a) (a, v, Type v a) (Type v a) (Type v a)
_3) ((v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> Type v a
-> Either (Seq (ResolutionFailure a)) (Type v a)
forall a v.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> Type v a
-> ResolutionResult a (Type v a)
Type.Names.bindNames v -> Name
unsafeVarToName Name -> v
nameToVar Set v
localNames Names
namespaceNames)