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

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

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

    Id
idEvidenceAllFields   <- forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceAllFields"
    Id
idEvidenceKnownFields <- forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceKnownFields"
    Id
idEvidenceKnownHash   <- forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceKnownHash"
    Id
idEvidenceRowHasField <- forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceRowHasField"
    Id
idEvidenceSubRow      <- forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"evidenceSubRow"
    Id
idUnsafeCoerce        <- forall (m :: * -> *). MonadTcPlugin m => String -> m Id
getVar String
"noInlineUnsafeCo"

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

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