{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE RecordWildCards #-}

module Data.Record.Anon.Internal.Plugin.TC.NameResolution (
    ResolvedNames(..)
  , nameResolution
  ) where

import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI

-- | Names we need to parse constraints or generate core
--
-- Listed alphabetically.
data ResolvedNames = ResolvedNames {
      ResolvedNames -> Class
clsAllFields          :: Class
    , ResolvedNames -> Class
clsKnownFields        :: Class
    , ResolvedNames -> Class
clsKnownHash          :: Class
    , ResolvedNames -> Class
clsRowHasField        :: Class
    , ResolvedNames -> Class
clsSubRow             :: Class
    , ResolvedNames -> DataCon
dataConDictAny        :: DataCon
    , ResolvedNames -> Id
idEvidenceAllFields   :: Id
    , ResolvedNames -> Id
idEvidenceKnownFields :: Id
    , ResolvedNames -> Id
idEvidenceKnownHash   :: Id
    , ResolvedNames -> Id
idEvidenceRowHasField :: Id
    , ResolvedNames -> Id
idEvidenceSubRow      :: Id
    , ResolvedNames -> Id
idMkDictAny           :: Id
    , ResolvedNames -> TyCon
tyConDictAny          :: TyCon
    , ResolvedNames -> TyCon
tyConMerge            :: TyCon
    , ResolvedNames -> TyCon
tyConFieldTypes       :: TyCon
    , ResolvedNames -> TyCon
tyConPair             :: TyCon
    , ResolvedNames -> TyCon
tyConSimpleFieldTypes :: TyCon
    }

nameResolution :: TcPluginM 'Init ResolvedNames
nameResolution :: TcPluginM 'Init ResolvedNames
nameResolution = do
    Module
modl <- String -> String -> TcPluginM 'Init Module
forall (m :: * -> *).
(HasCallStack, MonadTcPlugin m) =>
String -> String -> m Module
getModule String
"large-anon" String
"Data.Record.Anon.Plugin.Internal.Runtime"

    let getClass       :: MonadTcPlugin m => String -> m Class
        getTyCon       :: MonadTcPlugin m => String -> m TyCon
        getDataCon     :: MonadTcPlugin m => String -> m DataCon
        getVar         :: MonadTcPlugin m => String -> m Id
        getPromDataCon :: MonadTcPlugin m => String -> m TyCon

        getClass :: forall (m :: * -> *). MonadTcPlugin m => String -> m Class
getClass       String
cls = Module -> OccName -> m Name
forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
modl (String -> OccName
mkTcOcc String
cls)   m Name -> (Name -> m Class) -> m Class
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> m Class
forall (m :: * -> *). MonadTcPlugin m => Name -> m Class
tcLookupClass
        getTyCon :: forall (m :: * -> *). MonadTcPlugin m => String -> m TyCon
getTyCon       String
con = Module -> OccName -> m Name
forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
modl (String -> OccName
mkTcOcc String
con)   m Name -> (Name -> m TyCon) -> m TyCon
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> m TyCon
forall (m :: * -> *). MonadTcPlugin m => Name -> m TyCon
tcLookupTyCon
        getDataCon :: forall (m :: * -> *). MonadTcPlugin m => String -> m DataCon
getDataCon     String
con = Module -> OccName -> m Name
forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
modl (String -> OccName
mkDataOcc String
con) m Name -> (Name -> m DataCon) -> m DataCon
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> m DataCon
forall (m :: * -> *). MonadTcPlugin m => Name -> m DataCon
tcLookupDataCon
        getVar :: forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar         String
var = Module -> OccName -> m Name
forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
modl (String -> OccName
mkVarOcc String
var)  m Name -> (Name -> m Id) -> m Id
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> m Id
forall (m :: * -> *). MonadTcPlugin m => Name -> m Id
tcLookupId
        getPromDataCon :: forall (m :: * -> *). MonadTcPlugin m => String -> m TyCon
getPromDataCon String
con = DataCon -> TyCon
promoteDataCon (DataCon -> TyCon) -> m DataCon -> m TyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m DataCon
forall (m :: * -> *). MonadTcPlugin m => String -> m DataCon
getDataCon String
con

    Class
clsAllFields          <- String -> TcPluginM 'Init Class
forall (m :: * -> *). MonadTcPlugin m => String -> m Class
getClass String
"AllFields"
    Class
clsKnownFields        <- String -> TcPluginM 'Init Class
forall (m :: * -> *). MonadTcPlugin m => String -> m Class
getClass String
"KnownFields"
    Class
clsKnownHash          <- String -> TcPluginM 'Init Class
forall (m :: * -> *). MonadTcPlugin m => String -> m Class
getClass String
"KnownHash"
    Class
clsRowHasField        <- String -> TcPluginM 'Init Class
forall (m :: * -> *). MonadTcPlugin m => String -> m Class
getClass String
"RowHasField"
    Class
clsSubRow             <- String -> TcPluginM 'Init Class
forall (m :: * -> *). MonadTcPlugin m => String -> m Class
getClass String
"SubRow"

    DataCon
dataConDictAny        <- String -> TcPluginM 'Init DataCon
forall (m :: * -> *). MonadTcPlugin m => String -> m DataCon
getDataCon String
"DictAny"

    Id
idEvidenceAllFields   <- String -> TcPluginM 'Init Id
forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceAllFields"
    Id
idEvidenceKnownFields <- String -> TcPluginM 'Init Id
forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceKnownFields"
    Id
idEvidenceKnownHash   <- String -> TcPluginM 'Init Id
forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceKnownHash"
    Id
idEvidenceRowHasField <- String -> TcPluginM 'Init Id
forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceRowHasField"
    Id
idEvidenceSubRow      <- String -> TcPluginM 'Init Id
forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceSubRow"
    Id
idMkDictAny           <- String -> TcPluginM 'Init Id
forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"mkDictAny"

    TyCon
tyConDictAny          <- String -> TcPluginM 'Init TyCon
forall (m :: * -> *). MonadTcPlugin m => String -> m TyCon
getTyCon       String
"DictAny"
    TyCon
tyConFieldTypes       <- String -> TcPluginM 'Init TyCon
forall (m :: * -> *). MonadTcPlugin m => String -> m TyCon
getTyCon       String
"FieldTypes"
    TyCon
tyConMerge            <- String -> TcPluginM 'Init TyCon
forall (m :: * -> *). MonadTcPlugin m => String -> m TyCon
getTyCon       String
"Merge"
    TyCon
tyConPair             <- String -> TcPluginM 'Init TyCon
forall (m :: * -> *). MonadTcPlugin m => String -> m TyCon
getPromDataCon String
":="
    TyCon
tyConSimpleFieldTypes <- String -> TcPluginM 'Init TyCon
forall (m :: * -> *). MonadTcPlugin m => String -> m TyCon
getTyCon       String
"SimpleFieldTypes"

    ResolvedNames -> TcPluginM 'Init ResolvedNames
forall a. a -> TcPluginM 'Init a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResolvedNames -> TcPluginM 'Init ResolvedNames)
-> ResolvedNames -> TcPluginM 'Init ResolvedNames
forall a b. (a -> b) -> a -> b
$ ResolvedNames {Id
TyCon
DataCon
Class
clsAllFields :: Class
clsKnownFields :: Class
clsKnownHash :: Class
clsRowHasField :: Class
clsSubRow :: Class
dataConDictAny :: DataCon
idEvidenceAllFields :: Id
idEvidenceKnownFields :: Id
idEvidenceKnownHash :: Id
idEvidenceRowHasField :: Id
idEvidenceSubRow :: Id
idMkDictAny :: Id
tyConDictAny :: TyCon
tyConMerge :: TyCon
tyConFieldTypes :: TyCon
tyConPair :: TyCon
tyConSimpleFieldTypes :: TyCon
clsAllFields :: Class
clsKnownFields :: Class
clsKnownHash :: Class
clsRowHasField :: Class
clsSubRow :: Class
dataConDictAny :: DataCon
idEvidenceAllFields :: Id
idEvidenceKnownFields :: Id
idEvidenceKnownHash :: Id
idEvidenceRowHasField :: Id
idEvidenceSubRow :: Id
idMkDictAny :: Id
tyConDictAny :: TyCon
tyConFieldTypes :: TyCon
tyConMerge :: TyCon
tyConPair :: TyCon
tyConSimpleFieldTypes :: TyCon
..}