{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Liquid.GHC.API.StableModule (
StableModule
, mkStableModule
, unStableModule
, toStableModule
, renderModule
) where
import qualified GHC
import qualified GHC.Unit.Types as GHC
import qualified GHC.Unit.Module as GHC
import Data.Hashable
import GHC.Generics hiding (to, moduleName)
import Data.Binary
newtype StableModule =
StableModule { StableModule -> Module
unStableModule :: GHC.Module }
deriving (forall x. StableModule -> Rep StableModule x)
-> (forall x. Rep StableModule x -> StableModule)
-> Generic StableModule
forall x. Rep StableModule x -> StableModule
forall x. StableModule -> Rep StableModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StableModule -> Rep StableModule x
from :: forall x. StableModule -> Rep StableModule x
$cto :: forall x. Rep StableModule x -> StableModule
to :: forall x. Rep StableModule x -> StableModule
Generic
toStableModule :: GHC.Module -> StableModule
toStableModule :: Module -> StableModule
toStableModule = Module -> StableModule
StableModule
moduleUnitId :: GHC.Module -> GHC.UnitId
moduleUnitId :: Module -> UnitId
moduleUnitId = Unit -> UnitId
GHC.toUnitId (Unit -> UnitId) -> (Module -> Unit) -> Module -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Unit
forall unit. GenModule unit -> unit
GHC.moduleUnit
renderModule :: GHC.Module -> String
renderModule :: Module -> String
renderModule Module
m = String
"Module { unitId = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (UnitId -> String
GHC.unitIdString (UnitId -> String) -> (Module -> UnitId) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UnitId
moduleUnitId (Module -> String) -> Module -> String
forall a b. (a -> b) -> a -> b
$ Module
m)
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", name = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ModuleName -> String
GHC.moduleNameString (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
m)
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" }"
instance Hashable GHC.ModuleName where
hashWithSalt :: Int -> ModuleName -> Int
hashWithSalt Int
i = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (String -> Int) -> (ModuleName -> String) -> ModuleName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString
instance Hashable StableModule where
hashWithSalt :: Int -> StableModule -> Int
hashWithSalt Int
s (StableModule Module
mdl) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Module -> String
GHC.moduleStableString Module
mdl)
instance Ord StableModule where
(StableModule Module
m1) compare :: StableModule -> StableModule -> Ordering
`compare` (StableModule Module
m2) = Module -> Module -> Ordering
GHC.stableModuleCmp Module
m1 Module
m2
instance Eq StableModule where
(StableModule Module
m1) == :: StableModule -> StableModule -> Bool
== (StableModule Module
m2) = (Module
m1 Module -> Module -> Ordering
`GHC.stableModuleCmp` Module
m2) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Show StableModule where
show :: StableModule -> String
show (StableModule Module
mdl) = String
"Stable" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
mdl
instance Binary StableModule where
put :: StableModule -> Put
put (StableModule Module
mdl) = do
String -> Put
forall t. Binary t => t -> Put
put (UnitId -> String
GHC.unitIdString (UnitId -> String) -> (Module -> UnitId) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UnitId
moduleUnitId (Module -> String) -> Module -> String
forall a b. (a -> b) -> a -> b
$ Module
mdl)
String -> Put
forall t. Binary t => t -> Put
put (ModuleName -> String
GHC.moduleNameString (ModuleName -> String)
-> (Module -> ModuleName) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName (Module -> String) -> Module -> String
forall a b. (a -> b) -> a -> b
$ Module
mdl)
get :: Get StableModule
get = do
String
uidStr <- Get String
forall t. Binary t => Get t
get
UnitId -> ModuleName -> StableModule
mkStableModule (String -> UnitId
GHC.stringToUnitId String
uidStr) (ModuleName -> StableModule)
-> (String -> ModuleName) -> String -> StableModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleName
GHC.mkModuleName (String -> StableModule) -> Get String -> Get StableModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
mkStableModule :: GHC.UnitId -> GHC.ModuleName -> StableModule
mkStableModule :: UnitId -> ModuleName -> StableModule
mkStableModule UnitId
uid ModuleName
modName =
let realUnit :: Unit
realUnit = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
GHC.RealUnit (Definite UnitId -> Unit) -> Definite UnitId -> Unit
forall a b. (a -> b) -> a -> b
$ UnitId -> Definite UnitId
forall unit. unit -> Definite unit
GHC.Definite UnitId
uid
in Module -> StableModule
StableModule (Unit -> ModuleName -> Module
forall unit. unit -> ModuleName -> GenModule unit
GHC.Module Unit
realUnit ModuleName
modName)