{-# LANGUAGE DeriveGeneric #-}
module Language.Haskell.Liquid.GHC.Types where

import           Data.HashSet (HashSet, fromList)
import           Data.Hashable
import           FamInstEnv
import           GHC.Generics hiding (moduleName)
import           Language.Haskell.Liquid.GHC.API

-- | 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 { StableName -> Name
unStableName :: Name }
  deriving (forall x. StableName -> Rep StableName x)
-> (forall x. Rep StableName x -> StableName) -> Generic StableName
forall x. Rep StableName x -> StableName
forall x. StableName -> Rep StableName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StableName x -> StableName
$cfrom :: forall x. StableName -> Rep StableName x
Generic

instance Show StableName where
  show :: StableName -> String
show (MkStableName Name
n) = Name -> String
nameStableString Name
n

instance Hashable StableName where
  hashWithSalt :: Int -> StableName -> Int
hashWithSalt Int
s (MkStableName Name
n) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Name -> String
nameStableString Name
n)

instance Eq StableName where
  (MkStableName Name
n1) == :: StableName -> StableName -> Bool
== (MkStableName Name
n2) = -- n1 `stableNameCmp` n2 == EQ
    let sameOccName :: Bool
sameOccName = (OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
n1) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
n2)
        sameModule :: Bool
sameModule  = HasDebugCallStack => Name -> Module
Name -> Module
nameModule  Name
n1 Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
Name -> Module
nameModule  Name
n2
        sameSrcLoc :: Bool
sameSrcLoc  = Name -> SrcLoc
nameSrcLoc  Name
n1 SrcLoc -> SrcLoc -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> SrcLoc
nameSrcLoc  Name
n2
        sameSrcSpan :: Bool
sameSrcSpan = Name -> SrcSpan
nameSrcSpan Name
n1 SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> SrcSpan
nameSrcSpan Name
n2
    in Bool
sameOccName Bool -> Bool -> Bool
&& Bool
sameModule Bool -> Bool -> Bool
&& Bool
sameSrcLoc  Bool -> Bool -> Bool
&& Bool
sameSrcSpan

-- | Creates a new 'StableName' out of a 'Name'.
mkStableName :: Name -> StableName
mkStableName :: Name -> StableName
mkStableName = Name -> StableName
MkStableName

-- | Converts a list of 'AvailInfo' into a \"StableNameSet\", similarly to what 'availsToNameSet' would do.
availsToStableNameSet :: [AvailInfo] -> HashSet StableName
availsToStableNameSet :: [AvailInfo] -> HashSet StableName
availsToStableNameSet [AvailInfo]
avails = (AvailInfo -> HashSet StableName -> HashSet StableName)
-> HashSet StableName -> [AvailInfo] -> HashSet StableName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> HashSet StableName -> HashSet StableName
add HashSet StableName
forall a. Monoid a => a
mempty [AvailInfo]
avails
      where add :: AvailInfo -> HashSet StableName -> HashSet StableName
add AvailInfo
av HashSet StableName
acc = HashSet StableName
acc HashSet StableName -> HashSet StableName -> HashSet StableName
forall a. Semigroup a => a -> a -> a
<> [StableName] -> HashSet StableName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList ((Name -> StableName) -> [Name] -> [StableName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> StableName
mkStableName (AvailInfo -> [Name]
availNames AvailInfo
av))

--------------------------------------------------------------------------------
-- | Datatype For Holding GHC ModGuts ------------------------------------------
--------------------------------------------------------------------------------
data MGIModGuts = MI 
  { MGIModGuts -> CoreProgram
mgi_binds     :: !CoreProgram
  , MGIModGuts -> Module
mgi_module    :: !Module
  , MGIModGuts -> Dependencies
mgi_deps      :: !Dependencies
  , MGIModGuts -> [ModuleName]
mgi_dir_imps  :: ![ModuleName]
  , MGIModGuts -> GlobalRdrEnv
mgi_rdr_env   :: !GlobalRdrEnv
  , MGIModGuts -> [TyCon]
mgi_tcs       :: ![TyCon]
  , MGIModGuts -> [FamInst]
mgi_fam_insts :: ![FamInst]
  , MGIModGuts -> HashSet StableName
mgi_exports   :: !(HashSet StableName)
  , MGIModGuts -> Maybe [ClsInst]
mgi_cls_inst  :: !(Maybe [ClsInst])
  }

miModGuts :: Maybe [ClsInst] -> ModGuts -> MGIModGuts
miModGuts :: Maybe [ClsInst] -> ModGuts -> MGIModGuts
miModGuts Maybe [ClsInst]
cls ModGuts
mg  = MI :: CoreProgram
-> Module
-> Dependencies
-> [ModuleName]
-> GlobalRdrEnv
-> [TyCon]
-> [FamInst]
-> HashSet StableName
-> Maybe [ClsInst]
-> MGIModGuts
MI 
  { mgi_binds :: CoreProgram
mgi_binds     = ModGuts -> CoreProgram
mg_binds ModGuts
mg
  , mgi_module :: Module
mgi_module    = ModGuts -> Module
mg_module ModGuts
mg
  , mgi_deps :: Dependencies
mgi_deps      = ModGuts -> Dependencies
mg_deps ModGuts
mg
  , mgi_dir_imps :: [ModuleName]
mgi_dir_imps  = ModGuts -> [ModuleName]
mg_dir_imps ModGuts
mg
  , mgi_rdr_env :: GlobalRdrEnv
mgi_rdr_env   = ModGuts -> GlobalRdrEnv
mg_rdr_env ModGuts
mg
  , mgi_tcs :: [TyCon]
mgi_tcs       = ModGuts -> [TyCon]
mg_tcs ModGuts
mg
  , mgi_fam_insts :: [FamInst]
mgi_fam_insts = ModGuts -> [FamInst]
mg_fam_insts ModGuts
mg
  , mgi_exports :: HashSet StableName
mgi_exports   = [AvailInfo] -> HashSet StableName
availsToStableNameSet ([AvailInfo] -> HashSet StableName)
-> [AvailInfo] -> HashSet StableName
forall a b. (a -> b) -> a -> b
$ ModGuts -> [AvailInfo]
mg_exports ModGuts
mg
  , mgi_cls_inst :: Maybe [ClsInst]
mgi_cls_inst  = Maybe [ClsInst]
cls
  }

nameSetToStableNameSet :: NameSet -> HashSet StableName
nameSetToStableNameSet :: NameSet -> HashSet StableName
nameSetToStableNameSet = [StableName] -> HashSet StableName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList ([StableName] -> HashSet StableName)
-> (NameSet -> [StableName]) -> NameSet -> HashSet StableName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> StableName) -> [Name] -> [StableName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> StableName
mkStableName ([Name] -> [StableName])
-> (NameSet -> [Name]) -> NameSet -> [StableName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSet -> [Name]
nameSetElemsStable

mg_dir_imps :: ModGuts -> [ModuleName]
mg_dir_imps :: ModGuts -> [ModuleName]
mg_dir_imps ModGuts
m = (ModuleName, Bool) -> ModuleName
forall a b. (a, b) -> a
fst ((ModuleName, Bool) -> ModuleName)
-> [(ModuleName, Bool)] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dependencies -> [(ModuleName, Bool)]
dep_mods (Dependencies -> [(ModuleName, Bool)])
-> Dependencies -> [(ModuleName, Bool)]
forall a b. (a -> b) -> a -> b
$ ModGuts -> Dependencies
mg_deps ModGuts
m)

mgi_namestring :: MGIModGuts -> String
mgi_namestring :: MGIModGuts -> String
mgi_namestring = ModuleName -> String
moduleNameString (ModuleName -> String)
-> (MGIModGuts -> ModuleName) -> MGIModGuts -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
moduleName (Module -> ModuleName)
-> (MGIModGuts -> Module) -> MGIModGuts -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MGIModGuts -> Module
mgi_module