content: {-# LANGUAGE DeriveGeneric #-}
  module Language.Haskell.Liquid.GHC.Types where
  
  import           Data.HashSet (HashSet, fromList)
  import           Data.Hashable
  import           GHC.Generics (Generic)
  import           Liquid.GHC.API
      ( AvailInfo
      , ClsInst
      , CoreProgram
      , ModGuts(mg_binds, mg_exports, mg_module, mg_tcs)
      , Module
      , Name
      , TyCon
      , availNames
      , moduleName
      , moduleNameString
      , nameModule
      , nameOccName
      , nameSrcLoc
      , nameSrcSpan
      , nameStableString
      , occNameString
      )
  
  -- | A 'StableName' is virtually isomorphic to a GHC's 'Name' but crucially we don't use
  -- the 'Eq' instance defined on a 'Name' because it's 'Unique'-based. In particular, GHC
  -- doesn't guarantee that if we load an interface multiple times we would get the same 'Unique' for the
  -- same 'Name', and this is a problem when we rely on 'Name's to be the same when we call 'isExportedVar',
  -- which used to use a 'NameSet' derived from the '[AvailInfo]'. As the name implies, a 'NameSet' uses a
  -- 'Name's 'Unique' for duplicate detection and indexing, and this would lead to 'Var's being resolved to
  -- a 'Name' which is basically the same, but it has a /different/ 'Unique', and that would cause the lookup
  -- inside the 'NameSet' to fail.
  newtype StableName =
    MkStableName { unStableName :: Name }
    deriving Generic
  
  instance Show StableName where
    show (MkStableName n) = nameStableString n
  
  instance Hashable StableName where
    hashWithSalt s (MkStableName n) = hashWithSalt s (nameStableString n)
  
  instance Eq StableName where
    (MkStableName n1) == (MkStableName n2) = -- n1 `stableNameCmp` n2 == EQ
      let sameOccName = occNameString (nameOccName n1) == occNameString (nameOccName n2)
          sameModule  = nameModule  n1 == nameModule  n2
          sameSrcLoc  = nameSrcLoc  n1 == nameSrcLoc  n2
          sameSrcSpan = nameSrcSpan n1 == nameSrcSpan n2
      in sameOccName && sameModule && sameSrcLoc  && sameSrcSpan
  
  -- | Creates a new 'StableName' out of a 'Name'.
  mkStableName :: Name -> StableName
  mkStableName = MkStableName
  
  -- | Converts a list of 'AvailInfo' into a \"StableNameSet\", similarly to what 'availsToNameSet' would do.
  availsToStableNameSet :: [AvailInfo] -> HashSet StableName
  availsToStableNameSet avails = foldr add mempty avails
        where add av acc = acc <> fromList (map mkStableName (availNames av))
  
  --------------------------------------------------------------------------------
  -- | Datatype For Holding GHC ModGuts ------------------------------------------
  --------------------------------------------------------------------------------
  data MGIModGuts = MI
    { mgi_binds     :: !CoreProgram
    , mgi_module    :: !Module
    , mgi_tcs       :: ![TyCon]
    , mgi_exports   :: !(HashSet StableName)
    , mgi_cls_inst  :: !(Maybe [ClsInst])
    }
  
  miModGuts :: Maybe [ClsInst] -> ModGuts -> MGIModGuts
  miModGuts cls mg  = MI
    { mgi_binds     = mg_binds mg
    , mgi_module    = mg_module mg
    , mgi_tcs       = mg_tcs mg
    , mgi_exports   = availsToStableNameSet $ mg_exports mg
    , mgi_cls_inst  = cls
    }
  
  mgiNamestring :: MGIModGuts -> String
  mgiNamestring = moduleNameString . moduleName . mgi_module
  