{-# LANGUAGE DeriveGeneric #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Liquid.GHC.API.StableModule (
    StableModule
  -- * Constructing a 'StableModule'
  , mkStableModule
  -- * Converting a 'StableModule' into a standard 'Module'
  , unStableModule
  -- * Utility functions
  , 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

-- | A newtype wrapper around a 'Module' which:
--
-- * Allows a 'Module' to be serialised (i.e. it has a 'Binary' instance)
-- * It tries to use stable comparison and equality under the hood.
--
newtype StableModule =
  StableModule { StableModule -> Module
unStableModule :: GHC.Module }
  deriving 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
$cto :: forall x. Rep StableModule x -> StableModule
$cfrom :: forall x. StableModule -> Rep StableModule x
Generic

-- | Converts a 'Module' into a 'StableModule'.
toStableModule :: GHC.Module -> StableModule
toStableModule :: Module -> StableModule
toStableModule = Module -> StableModule
StableModule

moduleUnitId :: GHC.Module -> GHC.UnitId
moduleUnitId :: Module -> UnitId
moduleUnitId = Unit -> UnitId
GHC.toUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> unit
GHC.moduleUnit

renderModule :: GHC.Module -> String
renderModule :: Module -> String
renderModule Module
m =    String
"Module { unitId = " forall a. Semigroup a => a -> a -> a
<> (UnitId -> String
GHC.unitIdString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UnitId
moduleUnitId forall a b. (a -> b) -> a -> b
$ Module
m)
                 forall a. Semigroup a => a -> a -> a
<> String
", name = " forall a. Semigroup a => a -> a -> a
<> ModuleName -> String
GHC.moduleNameString (forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
m)
                 forall a. Semigroup a => a -> a -> a
<> String
" }"

-- These two orphans originally lived inside module 'Language.Haskell.Liquid.Types.Types'.
instance Hashable GHC.ModuleName where
  hashWithSalt :: Int -> ModuleName -> Int
hashWithSalt Int
i = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i 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) = 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) forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Show StableModule where
    show :: StableModule -> String
show (StableModule Module
mdl) = String
"Stable" forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
mdl

instance Binary StableModule where

    put :: StableModule -> Put
put (StableModule Module
mdl) = do
      forall t. Binary t => t -> Put
put (UnitId -> String
GHC.unitIdString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UnitId
moduleUnitId forall a b. (a -> b) -> a -> b
$ Module
mdl)
      forall t. Binary t => t -> Put
put (ModuleName -> String
GHC.moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName forall a b. (a -> b) -> a -> b
$ Module
mdl)

    get :: Get StableModule
get = do
      String
uidStr <- forall t. Binary t => Get t
get
      UnitId -> ModuleName -> StableModule
mkStableModule (String -> UnitId
GHC.stringToUnitId String
uidStr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleName
GHC.mkModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

--
-- Compat shim layer
--

-- | Creates a new 'StableModule' out of a 'ModuleName' and a 'UnitId'.
mkStableModule :: GHC.UnitId -> GHC.ModuleName -> StableModule
mkStableModule :: UnitId -> ModuleName -> StableModule
mkStableModule UnitId
uid ModuleName
modName =
  let realUnit :: Unit
realUnit = forall uid. Definite uid -> GenUnit uid
GHC.RealUnit forall a b. (a -> b) -> a -> b
$ forall unit. unit -> Definite unit
GHC.Definite UnitId
uid
  in Module -> StableModule
StableModule (forall unit. unit -> ModuleName -> GenModule unit
GHC.Module Unit
realUnit ModuleName
modName)