-- 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           Retrie.ExactPrint          (Annotated)

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

-- 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 () -> () -> ()
`seq` Module -> ()
forall a. NFData a => a -> ()
rnf Module
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 () -> () -> ()
`seq` (SptEntry -> ()) -> [SptEntry] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf SptEntry -> ()
forall a. a -> ()
rwhnf [SptEntry]
b
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

#if !MIN_VERSION_ghc(9,0,1)
instance Show ComponentId  where show :: ComponentId -> String
show = Text -> String
unpack (Text -> String) -> (ComponentId -> Text) -> ComponentId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentId -> Text
forall a. Outputable a => a -> Text
printOutputable
instance Show SourcePackageId  where show :: SourcePackageId -> String
show = Text -> String
unpack (Text -> String)
-> (SourcePackageId -> Text) -> SourcePackageId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePackageId -> Text
forall a. Outputable a => a -> Text
printOutputable

instance Show GhcPlugins.InstalledUnitId where
    show :: InstalledUnitId -> String
show = InstalledUnitId -> String
installedUnitIdString

instance NFData GhcPlugins.InstalledUnitId where rnf :: InstalledUnitId -> ()
rnf = FastString -> ()
forall a. a -> ()
rwhnf (FastString -> ())
-> (InstalledUnitId -> FastString) -> InstalledUnitId -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledUnitId -> FastString
installedUnitIdFS

instance Hashable GhcPlugins.InstalledUnitId where
  hashWithSalt :: Int -> InstalledUnitId -> Int
hashWithSalt Int
salt = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (String -> Int)
-> (InstalledUnitId -> String) -> InstalledUnitId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledUnitId -> String
installedUnitIdString
#else
instance Show UnitId where show = unpack . printOutputable
deriving instance Ord SrcSpan
deriving instance Ord UnhelpfulSpanReason
#endif

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
moduleName

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

instance (NFData l, NFData e) => NFData (GenLocated l e) where
    rnf :: GenLocated l e -> ()
rnf (L l
l e
e) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` e -> ()
forall a. NFData a => a -> ()
rnf e
e

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

#if !MIN_VERSION_ghc(8,10,0)
instance NFData FastString where
    rnf = rwhnf
#endif

#if MIN_VERSION_ghc(9,2,0)
instance Ord FastString where
    compare a b = if a == b then EQ else compare (fs_sbs a) (fs_sbs b)

instance NFData (SrcSpanAnn' a) where
    rnf = rwhnf

instance Bifunctor (GenLocated) where
    bimap f g (L l x) = L (f l) (g x)

deriving instance Functor SrcSpanAnn'
#endif

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

deriving instance Eq SourceModified
deriving instance Show SourceModified
instance NFData SourceModified where
    rnf :: SourceModified -> ()
rnf = SourceModified -> ()
forall a. a -> ()
rwhnf

#if !MIN_VERSION_ghc(9,2,0)
instance Show ModuleName where
    show :: ModuleName -> String
show = ModuleName -> String
moduleNameString
#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 () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf (Set ContextInfo -> 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 kv v. (KeyValue 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 (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 (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 (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

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

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

instance Show (Annotated ParsedSource) where
  show :: Annotated ParsedSource -> String
show Annotated ParsedSource
_ = String
"<Annotated ParsedSource>"

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

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