1-- Copyright (c) 2019 The DAML Authors. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
3
4{-# LANGUAGE CPP               #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# OPTIONS_GHC -Wno-orphans #-}
7
8-- | Orphan instances for GHC.
9--   Note that the 'NFData' instances may not be law abiding.
10module Development.IDE.GHC.Orphans() where
11
12import           Bag
13import           Control.DeepSeq
14import           Data.Aeson
15import           Data.Hashable
16import           Data.String                (IsString (fromString))
17import           Data.Text                  (Text)
18import           Development.IDE.GHC.Compat
19import           Development.IDE.GHC.Util
20import           GHC                        ()
21import           GhcPlugins
22import           Retrie.ExactPrint          (Annotated)
23import qualified StringBuffer               as SB
24import           Unique                     (getKey)
25
26
27-- Orphan instances for types from the GHC API.
28instance Show CoreModule where show = prettyPrint
29instance NFData CoreModule where rnf = rwhnf
30instance Show CgGuts where show = prettyPrint . cg_module
31instance NFData CgGuts where rnf = rwhnf
32instance Show ModDetails where show = const "<moddetails>"
33instance NFData ModDetails where rnf = rwhnf
34instance NFData SafeHaskellMode where rnf = rwhnf
35instance Show Linkable where show = prettyPrint
36instance NFData Linkable where rnf = rwhnf
37instance Show PackageFlag where show = prettyPrint
38instance Show InteractiveImport where show = prettyPrint
39instance Show PackageName  where show = prettyPrint
40
41#if !MIN_VERSION_ghc(9,0,1)
42instance Show ComponentId  where show = prettyPrint
43instance Show SourcePackageId  where show = prettyPrint
44
45instance Show GhcPlugins.InstalledUnitId where
46    show = installedUnitIdString
47
48instance NFData GhcPlugins.InstalledUnitId where rnf = rwhnf . installedUnitIdFS
49
50instance Hashable GhcPlugins.InstalledUnitId where
51  hashWithSalt salt = hashWithSalt salt . installedUnitIdString
52#else
53instance Show InstalledUnitId where show = prettyPrint
54deriving instance Ord SrcSpan
55deriving instance Ord UnhelpfulSpanReason
56#endif
57
58instance NFData SB.StringBuffer where rnf = rwhnf
59
60instance Show Module where
61    show = moduleNameString . moduleName
62
63instance Outputable a => Show (GenLocated SrcSpan a) where show = prettyPrint
64
65instance (NFData l, NFData e) => NFData (GenLocated l e) where
66    rnf (L l e) = rnf l `seq` rnf e
67
68instance Show ModSummary where
69    show = show . ms_mod
70
71instance Show ParsedModule where
72    show = show . pm_mod_summary
73
74instance NFData ModSummary where
75    rnf = rwhnf
76
77#if !MIN_VERSION_ghc(8,10,0)
78instance NFData FastString where
79    rnf = rwhnf
80#endif
81
82instance NFData ParsedModule where
83    rnf = rwhnf
84
85instance Show HieFile where
86    show = show . hie_module
87
88instance NFData HieFile where
89    rnf = rwhnf
90
91deriving instance Eq SourceModified
92deriving instance Show SourceModified
93instance NFData SourceModified where
94    rnf = rwhnf
95
96instance Show ModuleName where
97    show = moduleNameString
98instance Hashable ModuleName where
99    hashWithSalt salt = hashWithSalt salt . show
100
101
102instance NFData a => NFData (IdentifierDetails a) where
103    rnf (IdentifierDetails a b) = rnf a `seq` rnf (length b)
104
105instance NFData RealSrcSpan where
106    rnf = rwhnf
107
108srcSpanFileTag, srcSpanStartLineTag, srcSpanStartColTag,
109    srcSpanEndLineTag, srcSpanEndColTag :: Text
110srcSpanFileTag = "srcSpanFile"
111srcSpanStartLineTag = "srcSpanStartLine"
112srcSpanStartColTag = "srcSpanStartCol"
113srcSpanEndLineTag = "srcSpanEndLine"
114srcSpanEndColTag = "srcSpanEndCol"
115
116instance ToJSON RealSrcSpan where
117  toJSON spn =
118      object
119        [ srcSpanFileTag .= unpackFS (srcSpanFile spn)
120        , srcSpanStartLineTag .= srcSpanStartLine spn
121        , srcSpanStartColTag .= srcSpanStartCol spn
122        , srcSpanEndLineTag .= srcSpanEndLine spn
123        , srcSpanEndColTag .= srcSpanEndCol spn
124        ]
125
126instance FromJSON RealSrcSpan where
127  parseJSON = withObject "object" $ \obj -> do
128      file <- fromString <$> (obj .: srcSpanFileTag)
129      mkRealSrcSpan
130        <$> (mkRealSrcLoc file
131                <$> obj .: srcSpanStartLineTag
132                <*> obj .: srcSpanStartColTag
133            )
134        <*> (mkRealSrcLoc file
135                <$> obj .: srcSpanEndLineTag
136                <*> obj .: srcSpanEndColTag
137            )
138
139instance NFData Type where
140    rnf = rwhnf
141
142instance Show a => Show (Bag a) where
143    show = show . bagToList
144
145instance NFData HsDocString where
146    rnf = rwhnf
147
148instance Show ModGuts where
149    show _ = "modguts"
150instance NFData ModGuts where
151    rnf = rwhnf
152
153instance NFData (ImportDecl GhcPs) where
154    rnf = rwhnf
155
156instance Show (Annotated ParsedSource) where
157  show _ = "<Annotated ParsedSource>"
158
159instance NFData (Annotated ParsedSource) where
160  rnf = rwhnf
161
162#if MIN_VERSION_ghc(9,0,1)
163instance (NFData HsModule) where
164#else
165instance (NFData (HsModule a)) where
166#endif
167  rnf = rwhnf
168
169instance Show OccName where show = prettyPrint
170instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique n)
171