{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}

{-# 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.Data (Data)
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 (Typeable StableModule
Typeable StableModule =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> StableModule -> c StableModule)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StableModule)
-> (StableModule -> Constr)
-> (StableModule -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StableModule))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StableModule))
-> ((forall b. Data b => b -> b) -> StableModule -> StableModule)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StableModule -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StableModule -> r)
-> (forall u. (forall d. Data d => d -> u) -> StableModule -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StableModule -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> StableModule -> m StableModule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StableModule -> m StableModule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StableModule -> m StableModule)
-> Data StableModule
StableModule -> Constr
StableModule -> DataType
(forall b. Data b => b -> b) -> StableModule -> StableModule
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StableModule -> u
forall u. (forall d. Data d => d -> u) -> StableModule -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StableModule -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StableModule -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StableModule
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StableModule -> c StableModule
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StableModule)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StableModule)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StableModule -> c StableModule
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StableModule -> c StableModule
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StableModule
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StableModule
$ctoConstr :: StableModule -> Constr
toConstr :: StableModule -> Constr
$cdataTypeOf :: StableModule -> DataType
dataTypeOf :: StableModule -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StableModule)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StableModule)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StableModule)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StableModule)
$cgmapT :: (forall b. Data b => b -> b) -> StableModule -> StableModule
gmapT :: (forall b. Data b => b -> b) -> StableModule -> StableModule
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StableModule -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StableModule -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StableModule -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StableModule -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StableModule -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> StableModule -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StableModule -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StableModule -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StableModule -> m StableModule
Data, (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)

-- | 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 = GenUnit UnitId -> UnitId
GHC.toUnitId (GenUnit UnitId -> UnitId)
-> (Module -> GenUnit UnitId) -> Module -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> GenUnit UnitId
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
" }"

-- These two orphans originally lived inside module 'Language.Haskell.Liquid.Types.Types'.
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
      uidStr <- Get String
forall t. Binary t => Get t
get
      mkStableModule (GHC.stringToUnitId uidStr) . GHC.mkModuleName <$> 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 :: GenUnit UnitId
realUnit = Definite UnitId -> GenUnit UnitId
forall uid. Definite uid -> GenUnit uid
GHC.RealUnit (Definite UnitId -> GenUnit UnitId)
-> Definite UnitId -> GenUnit UnitId
forall a b. (a -> b) -> a -> b
$ UnitId -> Definite UnitId
forall unit. unit -> Definite unit
GHC.Definite UnitId
uid
  in Module -> StableModule
StableModule (GenUnit UnitId -> ModuleName -> Module
forall unit. unit -> ModuleName -> GenModule unit
GHC.Module GenUnit UnitId
realUnit ModuleName
modName)