{-# 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 { StableName -> Name
unStableName :: Name }
  deriving 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) = 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 (Name -> OccName
nameOccName Name
n1) forall a. Eq a => a -> a -> Bool
== OccName -> String
occNameString (Name -> OccName
nameOccName Name
n2)
        sameModule :: Bool
sameModule  = HasDebugCallStack => Name -> Module
nameModule  Name
n1 forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
nameModule  Name
n2
        sameSrcLoc :: Bool
sameSrcLoc  = Name -> SrcLoc
nameSrcLoc  Name
n1 forall a. Eq a => a -> a -> Bool
== Name -> SrcLoc
nameSrcLoc  Name
n2
        sameSrcSpan :: Bool
sameSrcSpan = Name -> SrcSpan
nameSrcSpan Name
n1 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> HashSet StableName -> HashSet StableName
add forall a. Monoid a => a
mempty [AvailInfo]
avails
      where add :: AvailInfo -> HashSet StableName -> HashSet StableName
add AvailInfo
av HashSet StableName
acc = HashSet StableName
acc forall a. Semigroup a => a -> a -> a
<> forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList (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 -> [TyCon]
mgi_tcs       :: ![TyCon]
  , 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
  { mgi_binds :: CoreProgram
mgi_binds     = ModGuts -> CoreProgram
mg_binds ModGuts
mg
  , mgi_module :: Module
mgi_module    = ModGuts -> Module
mg_module ModGuts
mg
  , mgi_tcs :: [TyCon]
mgi_tcs       = ModGuts -> [TyCon]
mg_tcs ModGuts
mg
  , mgi_exports :: HashSet StableName
mgi_exports   = [AvailInfo] -> HashSet StableName
availsToStableNameSet forall a b. (a -> b) -> a -> b
$ ModGuts -> [AvailInfo]
mg_exports ModGuts
mg
  , mgi_cls_inst :: Maybe [ClsInst]
mgi_cls_inst  = Maybe [ClsInst]
cls
  }

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