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

{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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)

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

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                        (ModuleGraph)
import           GHC.Types.Unique           (getKey)
#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
#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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable
instance NFData CoreModule where rnf :: CoreModule -> ()
rnf = forall a. a -> ()
rwhnf
instance Show CgGuts where show :: CgGuts -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable forall b c a. (b -> c) -> (a -> b) -> a -> c
. CgGuts -> Module
cg_module
instance NFData CgGuts where rnf :: CgGuts -> ()
rnf = forall a. a -> ()
rwhnf
instance Show ModDetails where show :: ModDetails -> String
show = forall a b. a -> b -> a
const String
"<moddetails>"
instance NFData ModDetails where rnf :: ModDetails -> ()
rnf = forall a. a -> ()
rwhnf
instance NFData SafeHaskellMode where rnf :: SafeHaskellMode -> ()
rnf = forall a. a -> ()
rwhnf
instance Show Linkable where show :: Linkable -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable
instance NFData Linkable where rnf :: Linkable -> ()
rnf (LM UTCTime
a Module
b [Unlinked]
c) = forall a. NFData a => a -> ()
rnf UTCTime
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Module
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Unlinked]
c
instance NFData Unlinked where
  rnf :: Unlinked -> ()
rnf (DotO String
f)   = forall a. NFData a => a -> ()
rnf String
f
  rnf (DotA String
f)   = forall a. NFData a => a -> ()
rnf String
f
  rnf (DotDLL String
f) = forall a. NFData a => a -> ()
rnf String
f
  rnf (BCOs CompiledByteCode
a [SptEntry]
b) = CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode
a seq :: forall a b. a -> b -> b
`seq` forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf forall a. a -> ()
rwhnf [SptEntry]
b
instance Show PackageFlag where show :: PackageFlag -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable
instance Show InteractiveImport where show :: InteractiveImport -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable
instance Show PackageName  where show :: PackageName -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable

instance Show UnitId where show :: UnitId -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable
deriving instance Ord SrcSpan
deriving instance Ord UnhelpfulSpanReason

instance NFData SB.StringBuffer where rnf :: StringBuffer -> ()
rnf = forall a. a -> ()
rwhnf

instance Show Module where
    show :: Module -> String
show = ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
moduleName

#if !MIN_VERSION_ghc(9,3,0)
instance Outputable a => Show (GenLocated SrcSpan a) where show :: GenLocated SrcSpan a -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> Text
printOutputable
#endif

#if !MIN_VERSION_ghc(9,5,0)
instance (NFData l, NFData e) => NFData (GenLocated l e) where
    rnf :: GenLocated l e -> ()
rnf (L l
l e
e) = forall a. NFData a => a -> ()
rnf l
l seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf e
e
#endif

instance Show ModSummary where
    show :: ModSummary -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod

instance Show ParsedModule where
    show :: ParsedModule -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary

instance NFData ModSummary where
    rnf :: ModSummary -> ()
rnf = forall a. a -> ()
rwhnf

instance Ord FastString where
    compare :: FastString -> FastString -> Ordering
compare FastString
a FastString
b = if FastString
a forall a. Eq a => a -> a -> Bool
== FastString
b then Ordering
EQ else forall a. Ord a => a -> a -> Ordering
compare (FastString -> ShortByteString
fs_sbs FastString
a) (FastString -> ShortByteString
fs_sbs FastString
b)

instance NFData (SrcSpanAnn' a) where
    rnf :: SrcSpanAnn' a -> ()
rnf = forall a. a -> ()
rwhnf

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) = forall l e. l -> e -> GenLocated l e
L (a -> b
f a
l) (c -> d
g c
x)

deriving instance Functor SrcSpanAnn'

instance NFData ParsedModule where
    rnf :: ParsedModule -> ()
rnf = forall a. a -> ()
rwhnf

instance Show HieFile where
    show :: HieFile -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> Module
hie_module

instance NFData HieFile where
    rnf :: HieFile -> ()
rnf = forall a. a -> ()
rwhnf

#if !MIN_VERSION_ghc(9,3,0)
deriving instance Eq SourceModified
deriving instance Show SourceModified
instance NFData SourceModified where
    rnf :: SourceModified -> ()
rnf = forall a. a -> ()
rwhnf
#endif

instance Hashable ModuleName where
    hashWithSalt :: Int -> ModuleName -> Int
hashWithSalt Int
salt = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a. NFData a => a -> ()
rnf Maybe a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf (forall (t :: * -> *) a. Foldable t => t a -> Int
length Set ContextInfo
b)

instance NFData RealSrcSpan where
    rnf :: RealSrcSpan -> ()
rnf = 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
        [ forall a. IsString a => String -> a
fromString String
srcSpanFileTag forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FastString -> String
unpackFS (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
spn)
        , forall a. IsString a => String -> a
fromString String
srcSpanStartLineTag forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
spn
        , forall a. IsString a => String -> a
fromString String
srcSpanStartColTag forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
spn
        , forall a. IsString a => String -> a
fromString String
srcSpanEndLineTag forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
spn
        , forall a. IsString a => String -> a
fromString String
srcSpanEndColTag forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
spn
        ]

instance FromJSON RealSrcSpan where
  parseJSON :: Value -> Parser RealSrcSpan
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"object" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      FastString
file <- forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: forall a. IsString a => String -> a
fromString String
srcSpanFileTag)
      RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: forall a. IsString a => String -> a
fromString String
srcSpanStartLineTag
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: forall a. IsString a => String -> a
fromString String
srcSpanStartColTag
            )
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: forall a. IsString a => String -> a
fromString String
srcSpanEndLineTag
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: forall a. IsString a => String -> a
fromString String
srcSpanEndColTag
            )

instance NFData Type where
    rnf :: Type -> ()
rnf = forall a. a -> ()
rwhnf

instance Show a => Show (Bag a) where
    show :: Bag a -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bag a -> [a]
bagToList

#if !MIN_VERSION_ghc(9,5,0)
instance NFData HsDocString where
    rnf :: HsDocString -> ()
rnf = forall a. a -> ()
rwhnf
#endif

instance Show ModGuts where
    show :: ModGuts -> String
show ModGuts
_ = String
"modguts"
instance NFData ModGuts where
    rnf :: ModGuts -> ()
rnf = forall a. a -> ()
rwhnf

instance NFData (ImportDecl GhcPs) where
    rnf :: ImportDecl GhcPs -> ()
rnf = forall a. a -> ()
rwhnf

#if MIN_VERSION_ghc(9,5,0)
instance (NFData (HsModule a)) where
#else
instance (NFData HsModule) where
#endif
  rnf :: HsModule -> ()
rnf = forall a. a -> ()
rwhnf

instance Show OccName where show :: OccName -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Unique -> Int
getKey forall a b. (a -> b) -> a -> b
$ forall a. Uniquable a => a -> Unique
getUnique OccName
n)
#endif

instance Show HomeModInfo where show :: HomeModInfo -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface

instance Show ModuleGraph where show :: ModuleGraph -> String
show ModuleGraph
_ = String
"ModuleGraph {..}"
instance NFData ModuleGraph where rnf :: ModuleGraph -> ()
rnf = forall a. a -> ()
rwhnf

instance NFData HomeModInfo where
  rnf :: HomeModInfo -> ()
rnf (HomeModInfo ModIface
iface ModDetails
dets Maybe Linkable
link) = forall a. a -> ()
rwhnf ModIface
iface seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf ModDetails
dets seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Linkable
link

#if MIN_VERSION_ghc(9,3,0)
instance NFData PkgQual where
  rnf NoPkgQual      = ()
  rnf (ThisPkg uid)  = rnf uid
  rnf (OtherPkg uid) = rnf uid

instance NFData UnitId where
  rnf = rwhnf

instance NFData NodeKey where
  rnf = rwhnf
#endif

#if MIN_VERSION_ghc(9,5,0)
instance NFData HomeModLinkable where
  rnf = rwhnf
#endif

instance NFData (HsExpr (GhcPass Renamed)) where
    rnf :: HsExpr (GhcPass 'Renamed) -> ()
rnf = forall a. a -> ()
rwhnf

instance NFData (Pat (GhcPass Renamed)) where
    rnf :: Pat (GhcPass 'Renamed) -> ()
rnf = forall a. a -> ()
rwhnf

instance NFData Extension where
  rnf :: Extension -> ()
rnf = forall a. a -> ()
rwhnf

instance NFData (UniqFM Name [Name]) where
  rnf :: UniqFM Name [Name] -> ()
rnf (forall key elt. UniqFM key elt -> IntMap elt
ufmToIntMap -> IntMap [Name]
m) = forall a. NFData a => a -> ()
rnf IntMap [Name]
m