-- 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

#if MIN_VERSION_ghc(9,2,0)
import           GHC.Parser.Annotation
#endif
#if MIN_VERSION_ghc(9,0,0)
import           GHC.Data.Bag
import           GHC.Data.FastString
import qualified GHC.Data.StringBuffer      as SB
import           GHC.Types.Name.Occurrence
import           GHC.Types.SrcLoc
import           GHC.Types.Unique           (getKey)
import           GHC.Unit.Info
import           GHC.Utils.Outputable
#else
import           Bag
import           GhcPlugins
import qualified StringBuffer               as SB
import           Unique                     (getKey)
#endif


import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Util

import           Control.DeepSeq
import           Data.Aeson
import           Data.Bifunctor             (Bifunctor (..))
import           Data.Hashable
import           Data.String                (IsString (fromString))
import           Data.Text                  (unpack)
#if MIN_VERSION_ghc(9,0,0)
import           GHC.ByteCode.Types
#else
import           ByteCodeTypes
#endif
#if MIN_VERSION_ghc(9,3,0)
import           GHC.Types.PkgQual
#endif

-- 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

#if !MIN_VERSION_ghc(9,0,1)
instance Show ComponentId  where show = unpack . printOutputable
instance Show SourcePackageId  where show = unpack . printOutputable

instance Show GhcPlugins.InstalledUnitId where
    show = installedUnitIdString

instance NFData GhcPlugins.InstalledUnitId where rnf = rwhnf . installedUnitIdFS

instance Hashable GhcPlugins.InstalledUnitId where
  hashWithSalt salt = hashWithSalt salt . installedUnitIdString
#else
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
#endif

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

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

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

#if MIN_VERSION_ghc(9,2,0)
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'
#endif

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

#if !MIN_VERSION_ghc(9,2,0)
instance Show ModuleName where
    show = moduleNameString
#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

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

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,0,1)
instance (NFData HsModule) where
#else
instance (NFData (HsModule a)) 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
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)

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 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