-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Orphan instances for GHC.
--   Note that the 'NFData' instances may not be law abiding.
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

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#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

-- Orphan instance for Shake.hs
-- https://hub.darcs.net/ross/transformers/issue/86
deriving instance (Semigroup (m a)) => Semigroup (ReaderT r m a)

-- Orphan instances for types from the GHC API.
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