{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Development.IDE.GHC.Orphans() where
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Util
import Control.DeepSeq
import Control.Monad.Trans.Reader (ReaderT (..))
import Data.Aeson
import Data.Hashable
import Data.String (IsString (fromString))
import Data.Text (unpack)
import GHC.ByteCode.Types
import GHC.Data.Bag
import GHC.Data.FastString
import qualified GHC.Data.StringBuffer as SB
import GHC.Types.SrcLoc
#if !MIN_VERSION_ghc(9,3,0)
import GHC.Types.Unique (getKey)
import GHC.Unit.Module.Graph (ModuleGraph)
#endif
import Data.Bifunctor (Bifunctor (..))
import GHC.Parser.Annotation
#if MIN_VERSION_ghc(9,3,0)
import GHC.Types.PkgQual
#endif
#if MIN_VERSION_ghc(9,5,0)
import GHC.Unit.Home.ModInfo
import GHC.Unit.Module.Location (ModLocation (..))
import GHC.Unit.Module.WholeCoreBindings
#endif
deriving instance (Semigroup (m a)) => Semigroup (ReaderT r m a)
instance Show CoreModule where show :: CoreModule -> String
show = Text -> String
unpack (Text -> String) -> (CoreModule -> Text) -> CoreModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreModule -> Text
forall a. Outputable a => a -> Text
printOutputable
instance NFData CoreModule where rnf :: CoreModule -> ()
rnf = CoreModule -> ()
forall a. a -> ()
rwhnf
instance Show CgGuts where show :: CgGuts -> String
show = Text -> String
unpack (Text -> String) -> (CgGuts -> Text) -> CgGuts -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Text
forall a. Outputable a => a -> Text
printOutputable (Module -> Text) -> (CgGuts -> Module) -> CgGuts -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CgGuts -> Module
cg_module
instance NFData CgGuts where rnf :: CgGuts -> ()
rnf = CgGuts -> ()
forall a. a -> ()
rwhnf
instance Show ModDetails where show :: ModDetails -> String
show = String -> ModDetails -> String
forall a b. a -> b -> a
const String
"<moddetails>"
instance NFData ModDetails where rnf :: ModDetails -> ()
rnf = ModDetails -> ()
forall a. a -> ()
rwhnf
instance NFData SafeHaskellMode where rnf :: SafeHaskellMode -> ()
rnf = SafeHaskellMode -> ()
forall a. a -> ()
rwhnf
instance Show Linkable where show :: Linkable -> String
show = Text -> String
unpack (Text -> String) -> (Linkable -> Text) -> Linkable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Linkable -> Text
forall a. Outputable a => a -> Text
printOutputable
instance NFData Linkable where rnf :: Linkable -> ()
rnf (LM UTCTime
a Module
b [Unlinked]
c) = UTCTime -> ()
forall a. NFData a => a -> ()
rnf UTCTime
a () -> () -> ()
forall a b. a -> b -> b
`seq` Module -> ()
forall a. NFData a => a -> ()
rnf Module
b () -> () -> ()
forall a b. a -> b -> b
`seq` [Unlinked] -> ()
forall a. NFData a => a -> ()
rnf [Unlinked]
c
instance NFData Unlinked where
rnf :: Unlinked -> ()
rnf (DotO String
f) = String -> ()
forall a. NFData a => a -> ()
rnf String
f
rnf (DotA String
f) = String -> ()
forall a. NFData a => a -> ()
rnf String
f
rnf (DotDLL String
f) = String -> ()
forall a. NFData a => a -> ()
rnf String
f
rnf (BCOs CompiledByteCode
a [SptEntry]
b) = CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode
a () -> () -> ()
forall a b. a -> b -> b
`seq` (SptEntry -> ()) -> [SptEntry] -> ()
forall a. (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf SptEntry -> ()
forall a. a -> ()
rwhnf [SptEntry]
b
#if MIN_VERSION_ghc(9,5,0)
rnf (CoreBindings WholeCoreBindings
wcb) = WholeCoreBindings -> ()
forall a. NFData a => a -> ()
rnf WholeCoreBindings
wcb
rnf (LoadedBCOs [Unlinked]
us) = [Unlinked] -> ()
forall a. NFData a => a -> ()
rnf [Unlinked]
us
instance NFData WholeCoreBindings where
rnf :: WholeCoreBindings -> ()
rnf (WholeCoreBindings [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
bs Module
m ModLocation
ml) = [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ()
forall a. NFData a => a -> ()
rnf [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
bs () -> () -> ()
forall a b. a -> b -> b
`seq` Module -> ()
forall a. NFData a => a -> ()
rnf Module
m () -> () -> ()
forall a b. a -> b -> b
`seq` ModLocation -> ()
forall a. NFData a => a -> ()
rnf ModLocation
ml
instance NFData ModLocation where
rnf :: ModLocation -> ()
rnf (ModLocation Maybe String
mf String
f1 String
f2 String
f3 String
f4 String
f5) = Maybe String -> ()
forall a. NFData a => a -> ()
rnf Maybe String
mf () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
f4 () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
f5
#endif
instance Show PackageFlag where show :: PackageFlag -> String
show = Text -> String
unpack (Text -> String) -> (PackageFlag -> Text) -> PackageFlag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageFlag -> Text
forall a. Outputable a => a -> Text
printOutputable
instance Show InteractiveImport where show :: InteractiveImport -> String
show = Text -> String
unpack (Text -> String)
-> (InteractiveImport -> Text) -> InteractiveImport -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractiveImport -> Text
forall a. Outputable a => a -> Text
printOutputable
instance Show PackageName where show :: PackageName -> String
show = Text -> String
unpack (Text -> String) -> (PackageName -> Text) -> PackageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Text
forall a. Outputable a => a -> Text
printOutputable
instance Show UnitId where show :: UnitId -> String
show = Text -> String
unpack (Text -> String) -> (UnitId -> Text) -> UnitId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> Text
forall a. Outputable a => a -> Text
printOutputable
deriving instance Ord SrcSpan
deriving instance Ord UnhelpfulSpanReason
instance NFData SB.StringBuffer where rnf :: StringBuffer -> ()
rnf = StringBuffer -> ()
forall a. a -> ()
rwhnf
instance Show Module where
show :: Module -> String
show = ModuleName -> String
moduleNameString (ModuleName -> String)
-> (Module -> ModuleName) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName
#if !MIN_VERSION_ghc(9,3,0)
instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable
#endif
#if !MIN_VERSION_ghc(9,5,0)
instance (NFData l, NFData e) => NFData (GenLocated l e) where
rnf (L l e) = rnf l `seq` rnf e
#endif
instance Show ModSummary where
show :: ModSummary -> String
show = Module -> String
forall a. Show a => a -> String
show (Module -> String)
-> (ModSummary -> Module) -> ModSummary -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod
instance Show ParsedModule where
show :: ParsedModule -> String
show = ModSummary -> String
forall a. Show a => a -> String
show (ModSummary -> String)
-> (ParsedModule -> ModSummary) -> ParsedModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary
instance NFData ModSummary where
rnf :: ModSummary -> ()
rnf = ModSummary -> ()
forall a. a -> ()
rwhnf
instance Ord FastString where
compare :: FastString -> FastString -> Ordering
compare FastString
a FastString
b = if FastString
a FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
b then Ordering
EQ else ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FastString -> ShortByteString
fs_sbs FastString
a) (FastString -> ShortByteString
fs_sbs FastString
b)
#if MIN_VERSION_ghc(9,9,0)
instance NFData (EpAnn a) where
rnf = rwhnf
#else
instance NFData (SrcSpanAnn' a) where
rnf :: SrcSpanAnn' a -> ()
rnf = SrcSpanAnn' a -> ()
forall a. a -> ()
rwhnf
deriving instance Functor SrcSpanAnn'
#endif
instance Bifunctor GenLocated where
bimap :: forall a b c d.
(a -> b) -> (c -> d) -> GenLocated a c -> GenLocated b d
bimap a -> b
f c -> d
g (L a
l c
x) = b -> d -> GenLocated b d
forall l e. l -> e -> GenLocated l e
L (a -> b
f a
l) (c -> d
g c
x)
instance NFData ParsedModule where
rnf :: ParsedModule -> ()
rnf = ParsedModule -> ()
forall a. a -> ()
rwhnf
instance Show HieFile where
show :: HieFile -> String
show = Module -> String
forall a. Show a => a -> String
show (Module -> String) -> (HieFile -> Module) -> HieFile -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> Module
hie_module
instance NFData HieFile where
rnf :: HieFile -> ()
rnf = HieFile -> ()
forall a. a -> ()
rwhnf
#if !MIN_VERSION_ghc(9,3,0)
deriving instance Eq SourceModified
deriving instance Show SourceModified
instance NFData SourceModified where
rnf = rwhnf
#endif
instance Hashable ModuleName where
hashWithSalt :: Int -> ModuleName -> Int
hashWithSalt Int
salt = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (String -> Int) -> (ModuleName -> String) -> ModuleName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
forall a. Show a => a -> String
show
instance NFData a => NFData (IdentifierDetails a) where
rnf :: IdentifierDetails a -> ()
rnf (IdentifierDetails Maybe a
a Set ContextInfo
b) = Maybe a -> ()
forall a. NFData a => a -> ()
rnf Maybe a
a () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf (Set ContextInfo -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set ContextInfo
b)
instance NFData RealSrcSpan where
rnf :: RealSrcSpan -> ()
rnf = RealSrcSpan -> ()
forall a. a -> ()
rwhnf
srcSpanFileTag, srcSpanStartLineTag, srcSpanStartColTag,
srcSpanEndLineTag, srcSpanEndColTag :: String
srcSpanFileTag :: String
srcSpanFileTag = String
"srcSpanFile"
srcSpanStartLineTag :: String
srcSpanStartLineTag = String
"srcSpanStartLine"
srcSpanStartColTag :: String
srcSpanStartColTag = String
"srcSpanStartCol"
srcSpanEndLineTag :: String
srcSpanEndLineTag = String
"srcSpanEndLine"
srcSpanEndColTag :: String
srcSpanEndColTag = String
"srcSpanEndCol"
instance ToJSON RealSrcSpan where
toJSON :: RealSrcSpan -> Value
toJSON RealSrcSpan
spn =
[Pair] -> Value
object
[ String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanFileTag Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FastString -> String
unpackFS (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
spn)
, String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanStartLineTag Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
spn
, String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanStartColTag Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
spn
, String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanEndLineTag Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
spn
, String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanEndColTag Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
spn
]
instance FromJSON RealSrcSpan where
parseJSON :: Value -> Parser RealSrcSpan
parseJSON = String
-> (Object -> Parser RealSrcSpan) -> Value -> Parser RealSrcSpan
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"object" ((Object -> Parser RealSrcSpan) -> Value -> Parser RealSrcSpan)
-> (Object -> Parser RealSrcSpan) -> Value -> Parser RealSrcSpan
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
FastString
file <- String -> FastString
forall a. IsString a => String -> a
fromString (String -> FastString) -> Parser String -> Parser FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanFileTag)
RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan
(RealSrcLoc -> RealSrcLoc -> RealSrcSpan)
-> Parser RealSrcLoc -> Parser (RealSrcLoc -> RealSrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file
(Int -> Int -> RealSrcLoc)
-> Parser Int -> Parser (Int -> RealSrcLoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanStartLineTag
Parser (Int -> RealSrcLoc) -> Parser Int -> Parser RealSrcLoc
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanStartColTag
)
Parser (RealSrcLoc -> RealSrcSpan)
-> Parser RealSrcLoc -> Parser RealSrcSpan
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file
(Int -> Int -> RealSrcLoc)
-> Parser Int -> Parser (Int -> RealSrcLoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanEndLineTag
Parser (Int -> RealSrcLoc) -> Parser Int -> Parser RealSrcLoc
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
srcSpanEndColTag
)
instance NFData Type where
rnf :: Type -> ()
rnf = Type -> ()
forall a. a -> ()
rwhnf
instance Show a => Show (Bag a) where
show :: Bag a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Bag a -> [a]) -> Bag a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> [a]
forall a. Bag a -> [a]
bagToList
#if !MIN_VERSION_ghc(9,5,0)
instance NFData HsDocString where
rnf = rwhnf
#endif
instance Show ModGuts where
show :: ModGuts -> String
show ModGuts
_ = String
"modguts"
instance NFData ModGuts where
rnf :: ModGuts -> ()
rnf = ModGuts -> ()
forall a. a -> ()
rwhnf
instance NFData (ImportDecl GhcPs) where
rnf :: ImportDecl GhcPs -> ()
rnf = ImportDecl GhcPs -> ()
forall a. a -> ()
rwhnf
#if MIN_VERSION_ghc(9,5,0)
instance (NFData (HsModule a)) where
#else
instance (NFData HsModule) where
#endif
rnf :: HsModule a -> ()
rnf = HsModule a -> ()
forall a. a -> ()
rwhnf
instance Show OccName where show :: OccName -> String
show = Text -> String
unpack (Text -> String) -> (OccName -> Text) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> Text
forall a. Outputable a => a -> Text
printOutputable
#if MIN_VERSION_ghc(9,7,0)
instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique $ occNameFS n, getKey $ getUnique $ occNameSpace n)
#else
instance Hashable OccName where hashWithSalt :: Int -> OccName -> Int
hashWithSalt Int
s OccName
n = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Unique -> Int
getKey (Unique -> Int) -> Unique -> Int
forall a b. (a -> b) -> a -> b
$ OccName -> Unique
forall a. Uniquable a => a -> Unique
getUnique OccName
n)
#endif
instance Show HomeModInfo where show :: HomeModInfo -> String
show = Module -> String
forall a. Show a => a -> String
show (Module -> String)
-> (HomeModInfo -> Module) -> HomeModInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (ModIface_ 'ModIfaceFinal -> Module)
-> (HomeModInfo -> ModIface_ 'ModIfaceFinal)
-> HomeModInfo
-> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface
instance Show ModuleGraph where show :: ModuleGraph -> String
show ModuleGraph
_ = String
"ModuleGraph {..}"
instance NFData ModuleGraph where rnf :: ModuleGraph -> ()
rnf = ModuleGraph -> ()
forall a. a -> ()
rwhnf
instance NFData HomeModInfo where
rnf :: HomeModInfo -> ()
rnf (HomeModInfo ModIface_ 'ModIfaceFinal
iface ModDetails
dets HomeModLinkable
link) = ModIface_ 'ModIfaceFinal -> ()
forall a. a -> ()
rwhnf ModIface_ 'ModIfaceFinal
iface () -> () -> ()
forall a b. a -> b -> b
`seq` ModDetails -> ()
forall a. NFData a => a -> ()
rnf ModDetails
dets () -> () -> ()
forall a b. a -> b -> b
`seq` HomeModLinkable -> ()
forall a. NFData a => a -> ()
rnf HomeModLinkable
link
#if MIN_VERSION_ghc(9,3,0)
instance NFData PkgQual where
rnf :: PkgQual -> ()
rnf PkgQual
NoPkgQual = ()
rnf (ThisPkg UnitId
uid) = UnitId -> ()
forall a. NFData a => a -> ()
rnf UnitId
uid
rnf (OtherPkg UnitId
uid) = UnitId -> ()
forall a. NFData a => a -> ()
rnf UnitId
uid
instance NFData UnitId where
rnf :: UnitId -> ()
rnf = UnitId -> ()
forall a. a -> ()
rwhnf
instance NFData NodeKey where
rnf :: NodeKey -> ()
rnf = NodeKey -> ()
forall a. a -> ()
rwhnf
#endif
#if MIN_VERSION_ghc(9,5,0)
instance NFData HomeModLinkable where
rnf :: HomeModLinkable -> ()
rnf = HomeModLinkable -> ()
forall a. a -> ()
rwhnf
#endif
instance NFData (HsExpr (GhcPass Renamed)) where
rnf :: HsExpr (GhcPass 'Renamed) -> ()
rnf = HsExpr (GhcPass 'Renamed) -> ()
forall a. a -> ()
rwhnf
instance NFData (Pat (GhcPass Renamed)) where
rnf :: Pat (GhcPass 'Renamed) -> ()
rnf = Pat (GhcPass 'Renamed) -> ()
forall a. a -> ()
rwhnf
instance NFData Extension where
rnf :: Extension -> ()
rnf = Extension -> ()
forall a. a -> ()
rwhnf
instance NFData (UniqFM Name [Name]) where
rnf :: UniqFM Name [Name] -> ()
rnf (UniqFM Name [Name] -> IntMap [Name]
forall key elt. UniqFM key elt -> IntMap elt
ufmToIntMap -> IntMap [Name]
m) = IntMap [Name] -> ()
forall a. NFData a => a -> ()
rnf IntMap [Name]
m