{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Core.RuleTypes(
GhcSessionDeps(.., GhcSessionDeps),
module Development.IDE.Core.RuleTypes
) where
import Control.DeepSeq
import qualified Control.Exception as E
import Control.Lens
import Data.Aeson.Types (Value)
import Data.Hashable
import qualified Data.Map as M
import Data.Time.Clock.POSIX
import Data.Typeable
import Development.IDE.GHC.Compat hiding
(HieFileResult)
import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.CoreFile
import Development.IDE.GHC.Util
import Development.IDE.Graph
import Development.IDE.Import.DependencyInformation
import Development.IDE.Types.HscEnvEq (HscEnvEq)
import Development.IDE.Types.KnownTargets
import GHC.Generics (Generic)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Development.IDE.Import.FindImports (ArtifactsLocation)
import Development.IDE.Spans.Common
import Development.IDE.Spans.LocalBindings
import Development.IDE.Types.Diagnostics
import GHC.Serialized (Serialized)
import Ide.Logger (Pretty (..),
viaShow)
import Language.LSP.Protocol.Types (Int32,
NormalizedFilePath)
data LinkableType = ObjectLinkable | BCOLinkable
deriving (LinkableType -> LinkableType -> Bool
(LinkableType -> LinkableType -> Bool)
-> (LinkableType -> LinkableType -> Bool) -> Eq LinkableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkableType -> LinkableType -> Bool
== :: LinkableType -> LinkableType -> Bool
$c/= :: LinkableType -> LinkableType -> Bool
/= :: LinkableType -> LinkableType -> Bool
Eq,Eq LinkableType
Eq LinkableType =>
(LinkableType -> LinkableType -> Ordering)
-> (LinkableType -> LinkableType -> Bool)
-> (LinkableType -> LinkableType -> Bool)
-> (LinkableType -> LinkableType -> Bool)
-> (LinkableType -> LinkableType -> Bool)
-> (LinkableType -> LinkableType -> LinkableType)
-> (LinkableType -> LinkableType -> LinkableType)
-> Ord LinkableType
LinkableType -> LinkableType -> Bool
LinkableType -> LinkableType -> Ordering
LinkableType -> LinkableType -> LinkableType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LinkableType -> LinkableType -> Ordering
compare :: LinkableType -> LinkableType -> Ordering
$c< :: LinkableType -> LinkableType -> Bool
< :: LinkableType -> LinkableType -> Bool
$c<= :: LinkableType -> LinkableType -> Bool
<= :: LinkableType -> LinkableType -> Bool
$c> :: LinkableType -> LinkableType -> Bool
> :: LinkableType -> LinkableType -> Bool
$c>= :: LinkableType -> LinkableType -> Bool
>= :: LinkableType -> LinkableType -> Bool
$cmax :: LinkableType -> LinkableType -> LinkableType
max :: LinkableType -> LinkableType -> LinkableType
$cmin :: LinkableType -> LinkableType -> LinkableType
min :: LinkableType -> LinkableType -> LinkableType
Ord,Int -> LinkableType -> ShowS
[LinkableType] -> ShowS
LinkableType -> String
(Int -> LinkableType -> ShowS)
-> (LinkableType -> String)
-> ([LinkableType] -> ShowS)
-> Show LinkableType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkableType -> ShowS
showsPrec :: Int -> LinkableType -> ShowS
$cshow :: LinkableType -> String
show :: LinkableType -> String
$cshowList :: [LinkableType] -> ShowS
showList :: [LinkableType] -> ShowS
Show, (forall x. LinkableType -> Rep LinkableType x)
-> (forall x. Rep LinkableType x -> LinkableType)
-> Generic LinkableType
forall x. Rep LinkableType x -> LinkableType
forall x. LinkableType -> Rep LinkableType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LinkableType -> Rep LinkableType x
from :: forall x. LinkableType -> Rep LinkableType x
$cto :: forall x. Rep LinkableType x -> LinkableType
to :: forall x. Rep LinkableType x -> LinkableType
Generic)
instance Hashable LinkableType
instance NFData LinkableType
encodeLinkableType :: Maybe LinkableType -> ByteString
encodeLinkableType :: Maybe LinkableType -> ByteString
encodeLinkableType Maybe LinkableType
Nothing = ByteString
"0"
encodeLinkableType (Just LinkableType
BCOLinkable) = ByteString
"1"
encodeLinkableType (Just LinkableType
ObjectLinkable) = ByteString
"2"
type instance RuleResult GetParsedModule = ParsedModule
type instance RuleResult GetParsedModuleWithComments = ParsedModule
type instance RuleResult GetModuleGraph = DependencyInformation
data GetKnownTargets = GetKnownTargets
deriving (Int -> GetKnownTargets -> ShowS
[GetKnownTargets] -> ShowS
GetKnownTargets -> String
(Int -> GetKnownTargets -> ShowS)
-> (GetKnownTargets -> String)
-> ([GetKnownTargets] -> ShowS)
-> Show GetKnownTargets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetKnownTargets -> ShowS
showsPrec :: Int -> GetKnownTargets -> ShowS
$cshow :: GetKnownTargets -> String
show :: GetKnownTargets -> String
$cshowList :: [GetKnownTargets] -> ShowS
showList :: [GetKnownTargets] -> ShowS
Show, (forall x. GetKnownTargets -> Rep GetKnownTargets x)
-> (forall x. Rep GetKnownTargets x -> GetKnownTargets)
-> Generic GetKnownTargets
forall x. Rep GetKnownTargets x -> GetKnownTargets
forall x. GetKnownTargets -> Rep GetKnownTargets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetKnownTargets -> Rep GetKnownTargets x
from :: forall x. GetKnownTargets -> Rep GetKnownTargets x
$cto :: forall x. Rep GetKnownTargets x -> GetKnownTargets
to :: forall x. Rep GetKnownTargets x -> GetKnownTargets
Generic, GetKnownTargets -> GetKnownTargets -> Bool
(GetKnownTargets -> GetKnownTargets -> Bool)
-> (GetKnownTargets -> GetKnownTargets -> Bool)
-> Eq GetKnownTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetKnownTargets -> GetKnownTargets -> Bool
== :: GetKnownTargets -> GetKnownTargets -> Bool
$c/= :: GetKnownTargets -> GetKnownTargets -> Bool
/= :: GetKnownTargets -> GetKnownTargets -> Bool
Eq, Eq GetKnownTargets
Eq GetKnownTargets =>
(GetKnownTargets -> GetKnownTargets -> Ordering)
-> (GetKnownTargets -> GetKnownTargets -> Bool)
-> (GetKnownTargets -> GetKnownTargets -> Bool)
-> (GetKnownTargets -> GetKnownTargets -> Bool)
-> (GetKnownTargets -> GetKnownTargets -> Bool)
-> (GetKnownTargets -> GetKnownTargets -> GetKnownTargets)
-> (GetKnownTargets -> GetKnownTargets -> GetKnownTargets)
-> Ord GetKnownTargets
GetKnownTargets -> GetKnownTargets -> Bool
GetKnownTargets -> GetKnownTargets -> Ordering
GetKnownTargets -> GetKnownTargets -> GetKnownTargets
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GetKnownTargets -> GetKnownTargets -> Ordering
compare :: GetKnownTargets -> GetKnownTargets -> Ordering
$c< :: GetKnownTargets -> GetKnownTargets -> Bool
< :: GetKnownTargets -> GetKnownTargets -> Bool
$c<= :: GetKnownTargets -> GetKnownTargets -> Bool
<= :: GetKnownTargets -> GetKnownTargets -> Bool
$c> :: GetKnownTargets -> GetKnownTargets -> Bool
> :: GetKnownTargets -> GetKnownTargets -> Bool
$c>= :: GetKnownTargets -> GetKnownTargets -> Bool
>= :: GetKnownTargets -> GetKnownTargets -> Bool
$cmax :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
max :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
$cmin :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
min :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
Ord)
instance Hashable GetKnownTargets
instance NFData GetKnownTargets
type instance RuleResult GetKnownTargets = KnownTargets
type instance RuleResult GenerateCore = ModGuts
data GenerateCore = GenerateCore
deriving (GenerateCore -> GenerateCore -> Bool
(GenerateCore -> GenerateCore -> Bool)
-> (GenerateCore -> GenerateCore -> Bool) -> Eq GenerateCore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateCore -> GenerateCore -> Bool
== :: GenerateCore -> GenerateCore -> Bool
$c/= :: GenerateCore -> GenerateCore -> Bool
/= :: GenerateCore -> GenerateCore -> Bool
Eq, Int -> GenerateCore -> ShowS
[GenerateCore] -> ShowS
GenerateCore -> String
(Int -> GenerateCore -> ShowS)
-> (GenerateCore -> String)
-> ([GenerateCore] -> ShowS)
-> Show GenerateCore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateCore -> ShowS
showsPrec :: Int -> GenerateCore -> ShowS
$cshow :: GenerateCore -> String
show :: GenerateCore -> String
$cshowList :: [GenerateCore] -> ShowS
showList :: [GenerateCore] -> ShowS
Show, Typeable, (forall x. GenerateCore -> Rep GenerateCore x)
-> (forall x. Rep GenerateCore x -> GenerateCore)
-> Generic GenerateCore
forall x. Rep GenerateCore x -> GenerateCore
forall x. GenerateCore -> Rep GenerateCore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenerateCore -> Rep GenerateCore x
from :: forall x. GenerateCore -> Rep GenerateCore x
$cto :: forall x. Rep GenerateCore x -> GenerateCore
to :: forall x. Rep GenerateCore x -> GenerateCore
Generic)
instance Hashable GenerateCore
instance NFData GenerateCore
type instance RuleResult GetLinkable = LinkableResult
data LinkableResult
= LinkableResult
{ LinkableResult -> HomeModInfo
linkableHomeMod :: !HomeModInfo
, LinkableResult -> ByteString
linkableHash :: !ByteString
}
instance Show LinkableResult where
show :: LinkableResult -> String
show = Module -> String
forall a. Show a => a -> String
show (Module -> String)
-> (LinkableResult -> Module) -> LinkableResult -> 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)
-> (LinkableResult -> ModIface_ 'ModIfaceFinal)
-> LinkableResult
-> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface (HomeModInfo -> ModIface_ 'ModIfaceFinal)
-> (LinkableResult -> HomeModInfo)
-> LinkableResult
-> ModIface_ 'ModIfaceFinal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkableResult -> HomeModInfo
linkableHomeMod
instance NFData LinkableResult where
rnf :: LinkableResult -> ()
rnf = LinkableResult -> ()
forall a. a -> ()
rwhnf
data GetLinkable = GetLinkable
deriving (GetLinkable -> GetLinkable -> Bool
(GetLinkable -> GetLinkable -> Bool)
-> (GetLinkable -> GetLinkable -> Bool) -> Eq GetLinkable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetLinkable -> GetLinkable -> Bool
== :: GetLinkable -> GetLinkable -> Bool
$c/= :: GetLinkable -> GetLinkable -> Bool
/= :: GetLinkable -> GetLinkable -> Bool
Eq, Int -> GetLinkable -> ShowS
[GetLinkable] -> ShowS
GetLinkable -> String
(Int -> GetLinkable -> ShowS)
-> (GetLinkable -> String)
-> ([GetLinkable] -> ShowS)
-> Show GetLinkable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetLinkable -> ShowS
showsPrec :: Int -> GetLinkable -> ShowS
$cshow :: GetLinkable -> String
show :: GetLinkable -> String
$cshowList :: [GetLinkable] -> ShowS
showList :: [GetLinkable] -> ShowS
Show, Typeable, (forall x. GetLinkable -> Rep GetLinkable x)
-> (forall x. Rep GetLinkable x -> GetLinkable)
-> Generic GetLinkable
forall x. Rep GetLinkable x -> GetLinkable
forall x. GetLinkable -> Rep GetLinkable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetLinkable -> Rep GetLinkable x
from :: forall x. GetLinkable -> Rep GetLinkable x
$cto :: forall x. Rep GetLinkable x -> GetLinkable
to :: forall x. Rep GetLinkable x -> GetLinkable
Generic)
instance Hashable GetLinkable
instance NFData GetLinkable
data GetImportMap = GetImportMap
deriving (GetImportMap -> GetImportMap -> Bool
(GetImportMap -> GetImportMap -> Bool)
-> (GetImportMap -> GetImportMap -> Bool) -> Eq GetImportMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetImportMap -> GetImportMap -> Bool
== :: GetImportMap -> GetImportMap -> Bool
$c/= :: GetImportMap -> GetImportMap -> Bool
/= :: GetImportMap -> GetImportMap -> Bool
Eq, Int -> GetImportMap -> ShowS
[GetImportMap] -> ShowS
GetImportMap -> String
(Int -> GetImportMap -> ShowS)
-> (GetImportMap -> String)
-> ([GetImportMap] -> ShowS)
-> Show GetImportMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetImportMap -> ShowS
showsPrec :: Int -> GetImportMap -> ShowS
$cshow :: GetImportMap -> String
show :: GetImportMap -> String
$cshowList :: [GetImportMap] -> ShowS
showList :: [GetImportMap] -> ShowS
Show, Typeable, (forall x. GetImportMap -> Rep GetImportMap x)
-> (forall x. Rep GetImportMap x -> GetImportMap)
-> Generic GetImportMap
forall x. Rep GetImportMap x -> GetImportMap
forall x. GetImportMap -> Rep GetImportMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetImportMap -> Rep GetImportMap x
from :: forall x. GetImportMap -> Rep GetImportMap x
$cto :: forall x. Rep GetImportMap x -> GetImportMap
to :: forall x. Rep GetImportMap x -> GetImportMap
Generic)
instance Hashable GetImportMap
instance NFData GetImportMap
type instance RuleResult GetImportMap = ImportMap
newtype ImportMap = ImportMap
{ ImportMap -> Map ModuleName NormalizedFilePath
importMap :: M.Map ModuleName NormalizedFilePath
} deriving stock Int -> ImportMap -> ShowS
[ImportMap] -> ShowS
ImportMap -> String
(Int -> ImportMap -> ShowS)
-> (ImportMap -> String)
-> ([ImportMap] -> ShowS)
-> Show ImportMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportMap -> ShowS
showsPrec :: Int -> ImportMap -> ShowS
$cshow :: ImportMap -> String
show :: ImportMap -> String
$cshowList :: [ImportMap] -> ShowS
showList :: [ImportMap] -> ShowS
Show
deriving newtype ImportMap -> ()
(ImportMap -> ()) -> NFData ImportMap
forall a. (a -> ()) -> NFData a
$crnf :: ImportMap -> ()
rnf :: ImportMap -> ()
NFData
data Splices = Splices
{ Splices -> [(LHsExpr GhcTc, LHsExpr GhcPs)]
exprSplices :: [(LHsExpr GhcTc, LHsExpr GhcPs)]
, Splices -> [(LHsExpr GhcTc, LPat GhcPs)]
patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
, Splices -> [(LHsExpr GhcTc, LHsType GhcPs)]
typeSplices :: [(LHsExpr GhcTc, LHsType GhcPs)]
, Splices -> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
declSplices :: [(LHsExpr GhcTc, [LHsDecl GhcPs])]
, Splices -> [(LHsExpr GhcTc, Serialized)]
awSplices :: [(LHsExpr GhcTc, Serialized)]
}
instance Semigroup Splices where
Splices [(LHsExpr GhcTc, LHsExpr GhcPs)]
e [(LHsExpr GhcTc, LPat GhcPs)]
p [(LHsExpr GhcTc, LHsType GhcPs)]
t [(LHsExpr GhcTc, [LHsDecl GhcPs])]
d [(LHsExpr GhcTc, Serialized)]
aw <> :: Splices -> Splices -> Splices
<> Splices [(LHsExpr GhcTc, LHsExpr GhcPs)]
e' [(LHsExpr GhcTc, LPat GhcPs)]
p' [(LHsExpr GhcTc, LHsType GhcPs)]
t' [(LHsExpr GhcTc, [LHsDecl GhcPs])]
d' [(LHsExpr GhcTc, Serialized)]
aw' =
[(LHsExpr GhcTc, LHsExpr GhcPs)]
-> [(LHsExpr GhcTc, LPat GhcPs)]
-> [(LHsExpr GhcTc, LHsType GhcPs)]
-> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
-> [(LHsExpr GhcTc, Serialized)]
-> Splices
Splices
([(LHsExpr GhcTc, LHsExpr GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
e [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. Semigroup a => a -> a -> a
<> [(LHsExpr GhcTc, LHsExpr GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
e')
([(LHsExpr GhcTc, LPat GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
p [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
forall a. Semigroup a => a -> a -> a
<> [(LHsExpr GhcTc, LPat GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
p')
([(LHsExpr GhcTc, LHsType GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
t [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. Semigroup a => a -> a -> a
<> [(LHsExpr GhcTc, LHsType GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
t')
([(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
d [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
forall a. Semigroup a => a -> a -> a
<> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
d')
([(LHsExpr GhcTc, Serialized)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc), Serialized)]
aw [(GenLocated SrcSpanAnnA (HsExpr GhcTc), Serialized)]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc), Serialized)]
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc), Serialized)]
forall a. Semigroup a => a -> a -> a
<> [(LHsExpr GhcTc, Serialized)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc), Serialized)]
aw')
instance Monoid Splices where
mempty :: Splices
mempty = [(LHsExpr GhcTc, LHsExpr GhcPs)]
-> [(LHsExpr GhcTc, LPat GhcPs)]
-> [(LHsExpr GhcTc, LHsType GhcPs)]
-> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
-> [(LHsExpr GhcTc, Serialized)]
-> Splices
Splices [(LHsExpr GhcTc, LHsExpr GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a. Monoid a => a
mempty [(LHsExpr GhcTc, LPat GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
forall a. Monoid a => a
mempty [(LHsExpr GhcTc, LHsType GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a. Monoid a => a
mempty [(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
forall a. Monoid a => a
mempty [(LHsExpr GhcTc, Serialized)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc), Serialized)]
forall a. Monoid a => a
mempty
instance NFData Splices where
rnf :: Splices -> ()
rnf Splices {[(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(LHsExpr GhcTc, LPat GhcPs)]
[(LHsExpr GhcTc, LHsExpr GhcPs)]
[(LHsExpr GhcTc, LHsType GhcPs)]
[(LHsExpr GhcTc, Serialized)]
exprSplices :: Splices -> [(LHsExpr GhcTc, LHsExpr GhcPs)]
patSplices :: Splices -> [(LHsExpr GhcTc, LPat GhcPs)]
typeSplices :: Splices -> [(LHsExpr GhcTc, LHsType GhcPs)]
declSplices :: Splices -> [(LHsExpr GhcTc, [LHsDecl GhcPs])]
awSplices :: Splices -> [(LHsExpr GhcTc, Serialized)]
exprSplices :: [(LHsExpr GhcTc, LHsExpr GhcPs)]
patSplices :: [(LHsExpr GhcTc, LPat GhcPs)]
typeSplices :: [(LHsExpr GhcTc, LHsType GhcPs)]
declSplices :: [(LHsExpr GhcTc, [LHsDecl GhcPs])]
awSplices :: [(LHsExpr GhcTc, Serialized)]
..} =
((GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ())
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> ()
forall a. (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf (GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ()
forall a. a -> ()
rwhnf [(LHsExpr GhcTc, LHsExpr GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsExpr GhcPs))]
exprSplices () -> () -> ()
forall a b. a -> b -> b
`seq`
((GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))
-> ())
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
-> ()
forall a. (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf (GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))
-> ()
forall a. a -> ()
rwhnf [(LHsExpr GhcTc, LPat GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (Pat GhcPs))]
patSplices () -> () -> ()
forall a b. a -> b -> b
`seq`
((GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))
-> ())
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
-> ()
forall a. (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf (GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))
-> ()
forall a. a -> ()
rwhnf [(LHsExpr GhcTc, LHsType GhcPs)]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
GenLocated SrcSpanAnnA (HsType GhcPs))]
typeSplices () -> () -> ()
forall a b. a -> b -> b
`seq` ((GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ())
-> [(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
-> ()
forall a. (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf (GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ()
forall a. a -> ()
rwhnf [(LHsExpr GhcTc, [LHsDecl GhcPs])]
[(GenLocated SrcSpanAnnA (HsExpr GhcTc),
[GenLocated SrcSpanAnnA (HsDecl GhcPs)])]
declSplices () -> () -> ()
forall a b. a -> b -> b
`seq` ()
data TcModuleResult = TcModuleResult
{ TcModuleResult -> ParsedModule
tmrParsed :: ParsedModule
, TcModuleResult -> RenamedSource
tmrRenamed :: RenamedSource
, TcModuleResult -> TcGblEnv
tmrTypechecked :: TcGblEnv
, TcModuleResult -> Splices
tmrTopLevelSplices :: Splices
, TcModuleResult -> Bool
tmrDeferredError :: !Bool
, TcModuleResult -> ModuleEnv ByteString
tmrRuntimeModules :: !(ModuleEnv ByteString)
}
instance Show TcModuleResult where
show :: TcModuleResult -> String
show = ModSummary -> String
forall a. Show a => a -> String
show (ModSummary -> String)
-> (TcModuleResult -> ModSummary) -> TcModuleResult -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary (ParsedModule -> ModSummary)
-> (TcModuleResult -> ParsedModule) -> TcModuleResult -> ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcModuleResult -> ParsedModule
tmrParsed
instance NFData TcModuleResult where
rnf :: TcModuleResult -> ()
rnf = TcModuleResult -> ()
forall a. a -> ()
rwhnf
tmrModSummary :: TcModuleResult -> ModSummary
tmrModSummary :: TcModuleResult -> ModSummary
tmrModSummary = ParsedModule -> ModSummary
pm_mod_summary (ParsedModule -> ModSummary)
-> (TcModuleResult -> ParsedModule) -> TcModuleResult -> ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcModuleResult -> ParsedModule
tmrParsed
data HiFileResult = HiFileResult
{ HiFileResult -> ModSummary
hirModSummary :: !ModSummary
, HiFileResult -> ModIface_ 'ModIfaceFinal
hirModIface :: !ModIface
, HiFileResult -> ModDetails
hirModDetails :: ModDetails
, HiFileResult -> ByteString
hirIfaceFp :: !ByteString
, HiFileResult -> ModuleEnv ByteString
hirRuntimeModules :: !(ModuleEnv ByteString)
, HiFileResult -> Maybe (CoreFile, ByteString)
hirCoreFp :: !(Maybe (CoreFile, ByteString))
}
hiFileFingerPrint :: HiFileResult -> ByteString
hiFileFingerPrint :: HiFileResult -> ByteString
hiFileFingerPrint HiFileResult{Maybe (CoreFile, ByteString)
ByteString
ModuleEnv ByteString
ModDetails
ModIface_ 'ModIfaceFinal
ModSummary
hirModSummary :: HiFileResult -> ModSummary
hirModIface :: HiFileResult -> ModIface_ 'ModIfaceFinal
hirModDetails :: HiFileResult -> ModDetails
hirIfaceFp :: HiFileResult -> ByteString
hirRuntimeModules :: HiFileResult -> ModuleEnv ByteString
hirCoreFp :: HiFileResult -> Maybe (CoreFile, ByteString)
hirModSummary :: ModSummary
hirModIface :: ModIface_ 'ModIfaceFinal
hirModDetails :: ModDetails
hirIfaceFp :: ByteString
hirRuntimeModules :: ModuleEnv ByteString
hirCoreFp :: Maybe (CoreFile, ByteString)
..} = ByteString
hirIfaceFp ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
-> ((CoreFile, ByteString) -> ByteString)
-> Maybe (CoreFile, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (CoreFile, ByteString) -> ByteString
forall a b. (a, b) -> b
snd Maybe (CoreFile, ByteString)
hirCoreFp
mkHiFileResult :: ModSummary -> ModIface -> ModDetails -> ModuleEnv ByteString -> Maybe (CoreFile, ByteString) -> HiFileResult
mkHiFileResult :: ModSummary
-> ModIface_ 'ModIfaceFinal
-> ModDetails
-> ModuleEnv ByteString
-> Maybe (CoreFile, ByteString)
-> HiFileResult
mkHiFileResult ModSummary
hirModSummary ModIface_ 'ModIfaceFinal
hirModIface ModDetails
hirModDetails ModuleEnv ByteString
hirRuntimeModules Maybe (CoreFile, ByteString)
hirCoreFp =
Bool -> HiFileResult -> HiFileResult
forall a. (?callStack::CallStack) => Bool -> a -> a
E.assert (case Maybe (CoreFile, ByteString)
hirCoreFp of
Just (CoreFile{Fingerprint
cf_iface_hash :: Fingerprint
cf_iface_hash :: CoreFile -> Fingerprint
cf_iface_hash}, ByteString
_) -> ModIface_ 'ModIfaceFinal -> Fingerprint
getModuleHash ModIface_ 'ModIfaceFinal
hirModIface Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== Fingerprint
cf_iface_hash
Maybe (CoreFile, ByteString)
_ -> Bool
True)
HiFileResult{Maybe (CoreFile, ByteString)
ByteString
ModuleEnv ByteString
ModDetails
ModIface_ 'ModIfaceFinal
ModSummary
hirModSummary :: ModSummary
hirModIface :: ModIface_ 'ModIfaceFinal
hirModDetails :: ModDetails
hirIfaceFp :: ByteString
hirRuntimeModules :: ModuleEnv ByteString
hirCoreFp :: Maybe (CoreFile, ByteString)
hirModSummary :: ModSummary
hirModIface :: ModIface_ 'ModIfaceFinal
hirModDetails :: ModDetails
hirRuntimeModules :: ModuleEnv ByteString
hirCoreFp :: Maybe (CoreFile, ByteString)
hirIfaceFp :: ByteString
..}
where
hirIfaceFp :: ByteString
hirIfaceFp = Fingerprint -> ByteString
fingerprintToBS (Fingerprint -> ByteString)
-> (ModIface_ 'ModIfaceFinal -> Fingerprint)
-> ModIface_ 'ModIfaceFinal
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface_ 'ModIfaceFinal -> Fingerprint
getModuleHash (ModIface_ 'ModIfaceFinal -> ByteString)
-> ModIface_ 'ModIfaceFinal -> ByteString
forall a b. (a -> b) -> a -> b
$ ModIface_ 'ModIfaceFinal
hirModIface
instance NFData HiFileResult where
rnf :: HiFileResult -> ()
rnf = HiFileResult -> ()
forall a. a -> ()
rwhnf
instance Show HiFileResult where
show :: HiFileResult -> String
show = ModSummary -> String
forall a. Show a => a -> String
show (ModSummary -> String)
-> (HiFileResult -> ModSummary) -> HiFileResult -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HiFileResult -> ModSummary
hirModSummary
data HieAstResult
= forall a . (Typeable a) => HAR
{ HieAstResult -> Module
hieModule :: Module
, ()
hieAst :: !(HieASTs a)
, ()
refMap :: RefMap a
, HieAstResult -> Map Name [RealSrcSpan]
typeRefs :: M.Map Name [RealSrcSpan]
, ()
hieKind :: !(HieKind a)
}
data HieKind a where
HieFromDisk :: !HieFile -> HieKind TypeIndex
HieFresh :: HieKind Type
instance NFData (HieKind a) where
rnf :: HieKind a -> ()
rnf (HieFromDisk HieFile
hf) = HieFile -> ()
forall a. NFData a => a -> ()
rnf HieFile
hf
rnf HieKind a
HieFresh = ()
instance NFData HieAstResult where
rnf :: HieAstResult -> ()
rnf (HAR Module
m HieASTs a
hf RefMap a
_rm Map Name [RealSrcSpan]
_tr HieKind a
kind) = Module -> ()
forall a. NFData a => a -> ()
rnf Module
m () -> () -> ()
forall a b. a -> b -> b
`seq` HieASTs a -> ()
forall a. a -> ()
rwhnf HieASTs a
hf () -> () -> ()
forall a b. a -> b -> b
`seq` HieKind a -> ()
forall a. NFData a => a -> ()
rnf HieKind a
kind
instance Show HieAstResult where
show :: HieAstResult -> String
show = Module -> String
forall a. Show a => a -> String
show (Module -> String)
-> (HieAstResult -> Module) -> HieAstResult -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAstResult -> Module
hieModule
type instance RuleResult TypeCheck = TcModuleResult
type instance RuleResult GetHieAst = HieAstResult
type instance RuleResult GetBindings = Bindings
data DocAndTyThingMap = DKMap {DocAndTyThingMap -> DocMap
getDocMap :: !DocMap, DocAndTyThingMap -> TyThingMap
getTyThingMap :: !TyThingMap}
instance NFData DocAndTyThingMap where
rnf :: DocAndTyThingMap -> ()
rnf (DKMap DocMap
a TyThingMap
b) = DocMap -> ()
forall a. a -> ()
rwhnf DocMap
a () -> () -> ()
forall a b. a -> b -> b
`seq` TyThingMap -> ()
forall a. a -> ()
rwhnf TyThingMap
b
instance Show DocAndTyThingMap where
show :: DocAndTyThingMap -> String
show = String -> DocAndTyThingMap -> String
forall a b. a -> b -> a
const String
"docmap"
type instance RuleResult GetDocMap = DocAndTyThingMap
type instance RuleResult GhcSession = HscEnvEq
type instance RuleResult GhcSessionDeps = HscEnvEq
type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe ArtifactsLocation)]
type instance RuleResult ReportImportCycles = ()
type instance RuleResult GetModIfaceFromDisk = HiFileResult
type instance RuleResult GetModIfaceFromDiskAndIndex = HiFileResult
type instance RuleResult GetModIface = HiFileResult
type instance RuleResult GetFileContents = (FileVersion, Maybe Text)
type instance RuleResult GetFileExists = Bool
type instance RuleResult AddWatchedFile = Bool
newtype GetModificationTime = GetModificationTime_
{ GetModificationTime -> Bool
missingFileDiagnostics :: Bool
}
deriving ((forall x. GetModificationTime -> Rep GetModificationTime x)
-> (forall x. Rep GetModificationTime x -> GetModificationTime)
-> Generic GetModificationTime
forall x. Rep GetModificationTime x -> GetModificationTime
forall x. GetModificationTime -> Rep GetModificationTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetModificationTime -> Rep GetModificationTime x
from :: forall x. GetModificationTime -> Rep GetModificationTime x
$cto :: forall x. Rep GetModificationTime x -> GetModificationTime
to :: forall x. Rep GetModificationTime x -> GetModificationTime
Generic)
instance Show GetModificationTime where
show :: GetModificationTime -> String
show GetModificationTime
_ = String
"GetModificationTime"
instance Eq GetModificationTime where
GetModificationTime
_ == :: GetModificationTime -> GetModificationTime -> Bool
== GetModificationTime
_ = Bool
True
instance Hashable GetModificationTime where
hashWithSalt :: Int -> GetModificationTime -> Int
hashWithSalt Int
salt GetModificationTime
_ = Int
salt
instance NFData GetModificationTime
pattern GetModificationTime :: GetModificationTime
pattern $mGetModificationTime :: forall {r}.
GetModificationTime -> ((# #) -> r) -> ((# #) -> r) -> r
$bGetModificationTime :: GetModificationTime
GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
type instance RuleResult GetModificationTime = FileVersion
data FileVersion
= ModificationTime !POSIXTime
| VFSVersion !Int32
deriving (Int -> FileVersion -> ShowS
[FileVersion] -> ShowS
FileVersion -> String
(Int -> FileVersion -> ShowS)
-> (FileVersion -> String)
-> ([FileVersion] -> ShowS)
-> Show FileVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileVersion -> ShowS
showsPrec :: Int -> FileVersion -> ShowS
$cshow :: FileVersion -> String
show :: FileVersion -> String
$cshowList :: [FileVersion] -> ShowS
showList :: [FileVersion] -> ShowS
Show, (forall x. FileVersion -> Rep FileVersion x)
-> (forall x. Rep FileVersion x -> FileVersion)
-> Generic FileVersion
forall x. Rep FileVersion x -> FileVersion
forall x. FileVersion -> Rep FileVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileVersion -> Rep FileVersion x
from :: forall x. FileVersion -> Rep FileVersion x
$cto :: forall x. Rep FileVersion x -> FileVersion
to :: forall x. Rep FileVersion x -> FileVersion
Generic, FileVersion -> FileVersion -> Bool
(FileVersion -> FileVersion -> Bool)
-> (FileVersion -> FileVersion -> Bool) -> Eq FileVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileVersion -> FileVersion -> Bool
== :: FileVersion -> FileVersion -> Bool
$c/= :: FileVersion -> FileVersion -> Bool
/= :: FileVersion -> FileVersion -> Bool
Eq, Eq FileVersion
Eq FileVersion =>
(FileVersion -> FileVersion -> Ordering)
-> (FileVersion -> FileVersion -> Bool)
-> (FileVersion -> FileVersion -> Bool)
-> (FileVersion -> FileVersion -> Bool)
-> (FileVersion -> FileVersion -> Bool)
-> (FileVersion -> FileVersion -> FileVersion)
-> (FileVersion -> FileVersion -> FileVersion)
-> Ord FileVersion
FileVersion -> FileVersion -> Bool
FileVersion -> FileVersion -> Ordering
FileVersion -> FileVersion -> FileVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FileVersion -> FileVersion -> Ordering
compare :: FileVersion -> FileVersion -> Ordering
$c< :: FileVersion -> FileVersion -> Bool
< :: FileVersion -> FileVersion -> Bool
$c<= :: FileVersion -> FileVersion -> Bool
<= :: FileVersion -> FileVersion -> Bool
$c> :: FileVersion -> FileVersion -> Bool
> :: FileVersion -> FileVersion -> Bool
$c>= :: FileVersion -> FileVersion -> Bool
>= :: FileVersion -> FileVersion -> Bool
$cmax :: FileVersion -> FileVersion -> FileVersion
max :: FileVersion -> FileVersion -> FileVersion
$cmin :: FileVersion -> FileVersion -> FileVersion
min :: FileVersion -> FileVersion -> FileVersion
Ord)
instance NFData FileVersion
vfsVersion :: FileVersion -> Maybe Int32
vfsVersion :: FileVersion -> Maybe Int32
vfsVersion (VFSVersion Int32
i) = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
i
vfsVersion ModificationTime{} = Maybe Int32
forall a. Maybe a
Nothing
data GetFileContents = GetFileContents
deriving (GetFileContents -> GetFileContents -> Bool
(GetFileContents -> GetFileContents -> Bool)
-> (GetFileContents -> GetFileContents -> Bool)
-> Eq GetFileContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetFileContents -> GetFileContents -> Bool
== :: GetFileContents -> GetFileContents -> Bool
$c/= :: GetFileContents -> GetFileContents -> Bool
/= :: GetFileContents -> GetFileContents -> Bool
Eq, Int -> GetFileContents -> ShowS
[GetFileContents] -> ShowS
GetFileContents -> String
(Int -> GetFileContents -> ShowS)
-> (GetFileContents -> String)
-> ([GetFileContents] -> ShowS)
-> Show GetFileContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetFileContents -> ShowS
showsPrec :: Int -> GetFileContents -> ShowS
$cshow :: GetFileContents -> String
show :: GetFileContents -> String
$cshowList :: [GetFileContents] -> ShowS
showList :: [GetFileContents] -> ShowS
Show, (forall x. GetFileContents -> Rep GetFileContents x)
-> (forall x. Rep GetFileContents x -> GetFileContents)
-> Generic GetFileContents
forall x. Rep GetFileContents x -> GetFileContents
forall x. GetFileContents -> Rep GetFileContents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetFileContents -> Rep GetFileContents x
from :: forall x. GetFileContents -> Rep GetFileContents x
$cto :: forall x. Rep GetFileContents x -> GetFileContents
to :: forall x. Rep GetFileContents x -> GetFileContents
Generic)
instance Hashable GetFileContents
instance NFData GetFileContents
data GetFileExists = GetFileExists
deriving (GetFileExists -> GetFileExists -> Bool
(GetFileExists -> GetFileExists -> Bool)
-> (GetFileExists -> GetFileExists -> Bool) -> Eq GetFileExists
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetFileExists -> GetFileExists -> Bool
== :: GetFileExists -> GetFileExists -> Bool
$c/= :: GetFileExists -> GetFileExists -> Bool
/= :: GetFileExists -> GetFileExists -> Bool
Eq, Int -> GetFileExists -> ShowS
[GetFileExists] -> ShowS
GetFileExists -> String
(Int -> GetFileExists -> ShowS)
-> (GetFileExists -> String)
-> ([GetFileExists] -> ShowS)
-> Show GetFileExists
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetFileExists -> ShowS
showsPrec :: Int -> GetFileExists -> ShowS
$cshow :: GetFileExists -> String
show :: GetFileExists -> String
$cshowList :: [GetFileExists] -> ShowS
showList :: [GetFileExists] -> ShowS
Show, Typeable, (forall x. GetFileExists -> Rep GetFileExists x)
-> (forall x. Rep GetFileExists x -> GetFileExists)
-> Generic GetFileExists
forall x. Rep GetFileExists x -> GetFileExists
forall x. GetFileExists -> Rep GetFileExists x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetFileExists -> Rep GetFileExists x
from :: forall x. GetFileExists -> Rep GetFileExists x
$cto :: forall x. Rep GetFileExists x -> GetFileExists
to :: forall x. Rep GetFileExists x -> GetFileExists
Generic)
instance NFData GetFileExists
instance Hashable GetFileExists
data FileOfInterestStatus
= OnDisk
| Modified { FileOfInterestStatus -> Bool
firstOpen :: !Bool
}
deriving (FileOfInterestStatus -> FileOfInterestStatus -> Bool
(FileOfInterestStatus -> FileOfInterestStatus -> Bool)
-> (FileOfInterestStatus -> FileOfInterestStatus -> Bool)
-> Eq FileOfInterestStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileOfInterestStatus -> FileOfInterestStatus -> Bool
== :: FileOfInterestStatus -> FileOfInterestStatus -> Bool
$c/= :: FileOfInterestStatus -> FileOfInterestStatus -> Bool
/= :: FileOfInterestStatus -> FileOfInterestStatus -> Bool
Eq, Int -> FileOfInterestStatus -> ShowS
[FileOfInterestStatus] -> ShowS
FileOfInterestStatus -> String
(Int -> FileOfInterestStatus -> ShowS)
-> (FileOfInterestStatus -> String)
-> ([FileOfInterestStatus] -> ShowS)
-> Show FileOfInterestStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileOfInterestStatus -> ShowS
showsPrec :: Int -> FileOfInterestStatus -> ShowS
$cshow :: FileOfInterestStatus -> String
show :: FileOfInterestStatus -> String
$cshowList :: [FileOfInterestStatus] -> ShowS
showList :: [FileOfInterestStatus] -> ShowS
Show, Typeable, (forall x. FileOfInterestStatus -> Rep FileOfInterestStatus x)
-> (forall x. Rep FileOfInterestStatus x -> FileOfInterestStatus)
-> Generic FileOfInterestStatus
forall x. Rep FileOfInterestStatus x -> FileOfInterestStatus
forall x. FileOfInterestStatus -> Rep FileOfInterestStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileOfInterestStatus -> Rep FileOfInterestStatus x
from :: forall x. FileOfInterestStatus -> Rep FileOfInterestStatus x
$cto :: forall x. Rep FileOfInterestStatus x -> FileOfInterestStatus
to :: forall x. Rep FileOfInterestStatus x -> FileOfInterestStatus
Generic)
instance Hashable FileOfInterestStatus
instance NFData FileOfInterestStatus
instance Pretty FileOfInterestStatus where
pretty :: forall ann. FileOfInterestStatus -> Doc ann
pretty = FileOfInterestStatus -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow
data IsFileOfInterestResult = NotFOI | IsFOI FileOfInterestStatus
deriving (IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
(IsFileOfInterestResult -> IsFileOfInterestResult -> Bool)
-> (IsFileOfInterestResult -> IsFileOfInterestResult -> Bool)
-> Eq IsFileOfInterestResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
== :: IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
$c/= :: IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
/= :: IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
Eq, Int -> IsFileOfInterestResult -> ShowS
[IsFileOfInterestResult] -> ShowS
IsFileOfInterestResult -> String
(Int -> IsFileOfInterestResult -> ShowS)
-> (IsFileOfInterestResult -> String)
-> ([IsFileOfInterestResult] -> ShowS)
-> Show IsFileOfInterestResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsFileOfInterestResult -> ShowS
showsPrec :: Int -> IsFileOfInterestResult -> ShowS
$cshow :: IsFileOfInterestResult -> String
show :: IsFileOfInterestResult -> String
$cshowList :: [IsFileOfInterestResult] -> ShowS
showList :: [IsFileOfInterestResult] -> ShowS
Show, Typeable, (forall x. IsFileOfInterestResult -> Rep IsFileOfInterestResult x)
-> (forall x.
Rep IsFileOfInterestResult x -> IsFileOfInterestResult)
-> Generic IsFileOfInterestResult
forall x. Rep IsFileOfInterestResult x -> IsFileOfInterestResult
forall x. IsFileOfInterestResult -> Rep IsFileOfInterestResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsFileOfInterestResult -> Rep IsFileOfInterestResult x
from :: forall x. IsFileOfInterestResult -> Rep IsFileOfInterestResult x
$cto :: forall x. Rep IsFileOfInterestResult x -> IsFileOfInterestResult
to :: forall x. Rep IsFileOfInterestResult x -> IsFileOfInterestResult
Generic)
instance Hashable IsFileOfInterestResult
instance NFData IsFileOfInterestResult
type instance RuleResult IsFileOfInterest = IsFileOfInterestResult
data ModSummaryResult = ModSummaryResult
{ ModSummaryResult -> ModSummary
msrModSummary :: !ModSummary
, ModSummaryResult -> [LImportDecl GhcPs]
msrImports :: [LImportDecl GhcPs]
, ModSummaryResult -> Fingerprint
msrFingerprint :: !Fingerprint
, ModSummaryResult -> HscEnv
msrHscEnv :: !HscEnv
}
instance Show ModSummaryResult where
show :: ModSummaryResult -> String
show ModSummaryResult
_ = String
"<ModSummaryResult>"
instance NFData ModSummaryResult where
rnf :: ModSummaryResult -> ()
rnf ModSummaryResult{[LImportDecl GhcPs]
Fingerprint
ModSummary
HscEnv
msrModSummary :: ModSummaryResult -> ModSummary
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrFingerprint :: ModSummaryResult -> Fingerprint
msrHscEnv :: ModSummaryResult -> HscEnv
msrModSummary :: ModSummary
msrImports :: [LImportDecl GhcPs]
msrFingerprint :: Fingerprint
msrHscEnv :: HscEnv
..} =
ModSummary -> ()
forall a. NFData a => a -> ()
rnf ModSummary
msrModSummary () -> () -> ()
forall a b. a -> b -> b
`seq` [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> ()
forall a. NFData a => a -> ()
rnf [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
msrImports () -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
msrFingerprint
type instance RuleResult GetModSummary = ModSummaryResult
type instance RuleResult GetModSummaryWithoutTimestamps = ModSummaryResult
data GetParsedModule = GetParsedModule
deriving (GetParsedModule -> GetParsedModule -> Bool
(GetParsedModule -> GetParsedModule -> Bool)
-> (GetParsedModule -> GetParsedModule -> Bool)
-> Eq GetParsedModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetParsedModule -> GetParsedModule -> Bool
== :: GetParsedModule -> GetParsedModule -> Bool
$c/= :: GetParsedModule -> GetParsedModule -> Bool
/= :: GetParsedModule -> GetParsedModule -> Bool
Eq, Int -> GetParsedModule -> ShowS
[GetParsedModule] -> ShowS
GetParsedModule -> String
(Int -> GetParsedModule -> ShowS)
-> (GetParsedModule -> String)
-> ([GetParsedModule] -> ShowS)
-> Show GetParsedModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetParsedModule -> ShowS
showsPrec :: Int -> GetParsedModule -> ShowS
$cshow :: GetParsedModule -> String
show :: GetParsedModule -> String
$cshowList :: [GetParsedModule] -> ShowS
showList :: [GetParsedModule] -> ShowS
Show, Typeable, (forall x. GetParsedModule -> Rep GetParsedModule x)
-> (forall x. Rep GetParsedModule x -> GetParsedModule)
-> Generic GetParsedModule
forall x. Rep GetParsedModule x -> GetParsedModule
forall x. GetParsedModule -> Rep GetParsedModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetParsedModule -> Rep GetParsedModule x
from :: forall x. GetParsedModule -> Rep GetParsedModule x
$cto :: forall x. Rep GetParsedModule x -> GetParsedModule
to :: forall x. Rep GetParsedModule x -> GetParsedModule
Generic)
instance Hashable GetParsedModule
instance NFData GetParsedModule
data =
deriving (GetParsedModuleWithComments -> GetParsedModuleWithComments -> Bool
(GetParsedModuleWithComments
-> GetParsedModuleWithComments -> Bool)
-> (GetParsedModuleWithComments
-> GetParsedModuleWithComments -> Bool)
-> Eq GetParsedModuleWithComments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetParsedModuleWithComments -> GetParsedModuleWithComments -> Bool
== :: GetParsedModuleWithComments -> GetParsedModuleWithComments -> Bool
$c/= :: GetParsedModuleWithComments -> GetParsedModuleWithComments -> Bool
/= :: GetParsedModuleWithComments -> GetParsedModuleWithComments -> Bool
Eq, Int -> GetParsedModuleWithComments -> ShowS
[GetParsedModuleWithComments] -> ShowS
GetParsedModuleWithComments -> String
(Int -> GetParsedModuleWithComments -> ShowS)
-> (GetParsedModuleWithComments -> String)
-> ([GetParsedModuleWithComments] -> ShowS)
-> Show GetParsedModuleWithComments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetParsedModuleWithComments -> ShowS
showsPrec :: Int -> GetParsedModuleWithComments -> ShowS
$cshow :: GetParsedModuleWithComments -> String
show :: GetParsedModuleWithComments -> String
$cshowList :: [GetParsedModuleWithComments] -> ShowS
showList :: [GetParsedModuleWithComments] -> ShowS
Show, Typeable, (forall x.
GetParsedModuleWithComments -> Rep GetParsedModuleWithComments x)
-> (forall x.
Rep GetParsedModuleWithComments x -> GetParsedModuleWithComments)
-> Generic GetParsedModuleWithComments
forall x.
Rep GetParsedModuleWithComments x -> GetParsedModuleWithComments
forall x.
GetParsedModuleWithComments -> Rep GetParsedModuleWithComments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetParsedModuleWithComments -> Rep GetParsedModuleWithComments x
from :: forall x.
GetParsedModuleWithComments -> Rep GetParsedModuleWithComments x
$cto :: forall x.
Rep GetParsedModuleWithComments x -> GetParsedModuleWithComments
to :: forall x.
Rep GetParsedModuleWithComments x -> GetParsedModuleWithComments
Generic)
instance Hashable GetParsedModuleWithComments
instance NFData GetParsedModuleWithComments
data GetLocatedImports = GetLocatedImports
deriving (GetLocatedImports -> GetLocatedImports -> Bool
(GetLocatedImports -> GetLocatedImports -> Bool)
-> (GetLocatedImports -> GetLocatedImports -> Bool)
-> Eq GetLocatedImports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetLocatedImports -> GetLocatedImports -> Bool
== :: GetLocatedImports -> GetLocatedImports -> Bool
$c/= :: GetLocatedImports -> GetLocatedImports -> Bool
/= :: GetLocatedImports -> GetLocatedImports -> Bool
Eq, Int -> GetLocatedImports -> ShowS
[GetLocatedImports] -> ShowS
GetLocatedImports -> String
(Int -> GetLocatedImports -> ShowS)
-> (GetLocatedImports -> String)
-> ([GetLocatedImports] -> ShowS)
-> Show GetLocatedImports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetLocatedImports -> ShowS
showsPrec :: Int -> GetLocatedImports -> ShowS
$cshow :: GetLocatedImports -> String
show :: GetLocatedImports -> String
$cshowList :: [GetLocatedImports] -> ShowS
showList :: [GetLocatedImports] -> ShowS
Show, Typeable, (forall x. GetLocatedImports -> Rep GetLocatedImports x)
-> (forall x. Rep GetLocatedImports x -> GetLocatedImports)
-> Generic GetLocatedImports
forall x. Rep GetLocatedImports x -> GetLocatedImports
forall x. GetLocatedImports -> Rep GetLocatedImports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetLocatedImports -> Rep GetLocatedImports x
from :: forall x. GetLocatedImports -> Rep GetLocatedImports x
$cto :: forall x. Rep GetLocatedImports x -> GetLocatedImports
to :: forall x. Rep GetLocatedImports x -> GetLocatedImports
Generic)
instance Hashable GetLocatedImports
instance NFData GetLocatedImports
type instance RuleResult NeedsCompilation = Maybe LinkableType
data NeedsCompilation = NeedsCompilation
deriving (NeedsCompilation -> NeedsCompilation -> Bool
(NeedsCompilation -> NeedsCompilation -> Bool)
-> (NeedsCompilation -> NeedsCompilation -> Bool)
-> Eq NeedsCompilation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NeedsCompilation -> NeedsCompilation -> Bool
== :: NeedsCompilation -> NeedsCompilation -> Bool
$c/= :: NeedsCompilation -> NeedsCompilation -> Bool
/= :: NeedsCompilation -> NeedsCompilation -> Bool
Eq, Int -> NeedsCompilation -> ShowS
[NeedsCompilation] -> ShowS
NeedsCompilation -> String
(Int -> NeedsCompilation -> ShowS)
-> (NeedsCompilation -> String)
-> ([NeedsCompilation] -> ShowS)
-> Show NeedsCompilation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NeedsCompilation -> ShowS
showsPrec :: Int -> NeedsCompilation -> ShowS
$cshow :: NeedsCompilation -> String
show :: NeedsCompilation -> String
$cshowList :: [NeedsCompilation] -> ShowS
showList :: [NeedsCompilation] -> ShowS
Show, Typeable, (forall x. NeedsCompilation -> Rep NeedsCompilation x)
-> (forall x. Rep NeedsCompilation x -> NeedsCompilation)
-> Generic NeedsCompilation
forall x. Rep NeedsCompilation x -> NeedsCompilation
forall x. NeedsCompilation -> Rep NeedsCompilation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NeedsCompilation -> Rep NeedsCompilation x
from :: forall x. NeedsCompilation -> Rep NeedsCompilation x
$cto :: forall x. Rep NeedsCompilation x -> NeedsCompilation
to :: forall x. Rep NeedsCompilation x -> NeedsCompilation
Generic)
instance Hashable NeedsCompilation
instance NFData NeedsCompilation
data GetModuleGraph = GetModuleGraph
deriving (GetModuleGraph -> GetModuleGraph -> Bool
(GetModuleGraph -> GetModuleGraph -> Bool)
-> (GetModuleGraph -> GetModuleGraph -> Bool) -> Eq GetModuleGraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetModuleGraph -> GetModuleGraph -> Bool
== :: GetModuleGraph -> GetModuleGraph -> Bool
$c/= :: GetModuleGraph -> GetModuleGraph -> Bool
/= :: GetModuleGraph -> GetModuleGraph -> Bool
Eq, Int -> GetModuleGraph -> ShowS
[GetModuleGraph] -> ShowS
GetModuleGraph -> String
(Int -> GetModuleGraph -> ShowS)
-> (GetModuleGraph -> String)
-> ([GetModuleGraph] -> ShowS)
-> Show GetModuleGraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetModuleGraph -> ShowS
showsPrec :: Int -> GetModuleGraph -> ShowS
$cshow :: GetModuleGraph -> String
show :: GetModuleGraph -> String
$cshowList :: [GetModuleGraph] -> ShowS
showList :: [GetModuleGraph] -> ShowS
Show, Typeable, (forall x. GetModuleGraph -> Rep GetModuleGraph x)
-> (forall x. Rep GetModuleGraph x -> GetModuleGraph)
-> Generic GetModuleGraph
forall x. Rep GetModuleGraph x -> GetModuleGraph
forall x. GetModuleGraph -> Rep GetModuleGraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetModuleGraph -> Rep GetModuleGraph x
from :: forall x. GetModuleGraph -> Rep GetModuleGraph x
$cto :: forall x. Rep GetModuleGraph x -> GetModuleGraph
to :: forall x. Rep GetModuleGraph x -> GetModuleGraph
Generic)
instance Hashable GetModuleGraph
instance NFData GetModuleGraph
data ReportImportCycles = ReportImportCycles
deriving (ReportImportCycles -> ReportImportCycles -> Bool
(ReportImportCycles -> ReportImportCycles -> Bool)
-> (ReportImportCycles -> ReportImportCycles -> Bool)
-> Eq ReportImportCycles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportImportCycles -> ReportImportCycles -> Bool
== :: ReportImportCycles -> ReportImportCycles -> Bool
$c/= :: ReportImportCycles -> ReportImportCycles -> Bool
/= :: ReportImportCycles -> ReportImportCycles -> Bool
Eq, Int -> ReportImportCycles -> ShowS
[ReportImportCycles] -> ShowS
ReportImportCycles -> String
(Int -> ReportImportCycles -> ShowS)
-> (ReportImportCycles -> String)
-> ([ReportImportCycles] -> ShowS)
-> Show ReportImportCycles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportImportCycles -> ShowS
showsPrec :: Int -> ReportImportCycles -> ShowS
$cshow :: ReportImportCycles -> String
show :: ReportImportCycles -> String
$cshowList :: [ReportImportCycles] -> ShowS
showList :: [ReportImportCycles] -> ShowS
Show, Typeable, (forall x. ReportImportCycles -> Rep ReportImportCycles x)
-> (forall x. Rep ReportImportCycles x -> ReportImportCycles)
-> Generic ReportImportCycles
forall x. Rep ReportImportCycles x -> ReportImportCycles
forall x. ReportImportCycles -> Rep ReportImportCycles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReportImportCycles -> Rep ReportImportCycles x
from :: forall x. ReportImportCycles -> Rep ReportImportCycles x
$cto :: forall x. Rep ReportImportCycles x -> ReportImportCycles
to :: forall x. Rep ReportImportCycles x -> ReportImportCycles
Generic)
instance Hashable ReportImportCycles
instance NFData ReportImportCycles
data TypeCheck = TypeCheck
deriving (TypeCheck -> TypeCheck -> Bool
(TypeCheck -> TypeCheck -> Bool)
-> (TypeCheck -> TypeCheck -> Bool) -> Eq TypeCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeCheck -> TypeCheck -> Bool
== :: TypeCheck -> TypeCheck -> Bool
$c/= :: TypeCheck -> TypeCheck -> Bool
/= :: TypeCheck -> TypeCheck -> Bool
Eq, Int -> TypeCheck -> ShowS
[TypeCheck] -> ShowS
TypeCheck -> String
(Int -> TypeCheck -> ShowS)
-> (TypeCheck -> String)
-> ([TypeCheck] -> ShowS)
-> Show TypeCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeCheck -> ShowS
showsPrec :: Int -> TypeCheck -> ShowS
$cshow :: TypeCheck -> String
show :: TypeCheck -> String
$cshowList :: [TypeCheck] -> ShowS
showList :: [TypeCheck] -> ShowS
Show, Typeable, (forall x. TypeCheck -> Rep TypeCheck x)
-> (forall x. Rep TypeCheck x -> TypeCheck) -> Generic TypeCheck
forall x. Rep TypeCheck x -> TypeCheck
forall x. TypeCheck -> Rep TypeCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeCheck -> Rep TypeCheck x
from :: forall x. TypeCheck -> Rep TypeCheck x
$cto :: forall x. Rep TypeCheck x -> TypeCheck
to :: forall x. Rep TypeCheck x -> TypeCheck
Generic)
instance Hashable TypeCheck
instance NFData TypeCheck
data GetDocMap = GetDocMap
deriving (GetDocMap -> GetDocMap -> Bool
(GetDocMap -> GetDocMap -> Bool)
-> (GetDocMap -> GetDocMap -> Bool) -> Eq GetDocMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetDocMap -> GetDocMap -> Bool
== :: GetDocMap -> GetDocMap -> Bool
$c/= :: GetDocMap -> GetDocMap -> Bool
/= :: GetDocMap -> GetDocMap -> Bool
Eq, Int -> GetDocMap -> ShowS
[GetDocMap] -> ShowS
GetDocMap -> String
(Int -> GetDocMap -> ShowS)
-> (GetDocMap -> String)
-> ([GetDocMap] -> ShowS)
-> Show GetDocMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetDocMap -> ShowS
showsPrec :: Int -> GetDocMap -> ShowS
$cshow :: GetDocMap -> String
show :: GetDocMap -> String
$cshowList :: [GetDocMap] -> ShowS
showList :: [GetDocMap] -> ShowS
Show, Typeable, (forall x. GetDocMap -> Rep GetDocMap x)
-> (forall x. Rep GetDocMap x -> GetDocMap) -> Generic GetDocMap
forall x. Rep GetDocMap x -> GetDocMap
forall x. GetDocMap -> Rep GetDocMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetDocMap -> Rep GetDocMap x
from :: forall x. GetDocMap -> Rep GetDocMap x
$cto :: forall x. Rep GetDocMap x -> GetDocMap
to :: forall x. Rep GetDocMap x -> GetDocMap
Generic)
instance Hashable GetDocMap
instance NFData GetDocMap
data GetHieAst = GetHieAst
deriving (GetHieAst -> GetHieAst -> Bool
(GetHieAst -> GetHieAst -> Bool)
-> (GetHieAst -> GetHieAst -> Bool) -> Eq GetHieAst
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetHieAst -> GetHieAst -> Bool
== :: GetHieAst -> GetHieAst -> Bool
$c/= :: GetHieAst -> GetHieAst -> Bool
/= :: GetHieAst -> GetHieAst -> Bool
Eq, Int -> GetHieAst -> ShowS
[GetHieAst] -> ShowS
GetHieAst -> String
(Int -> GetHieAst -> ShowS)
-> (GetHieAst -> String)
-> ([GetHieAst] -> ShowS)
-> Show GetHieAst
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetHieAst -> ShowS
showsPrec :: Int -> GetHieAst -> ShowS
$cshow :: GetHieAst -> String
show :: GetHieAst -> String
$cshowList :: [GetHieAst] -> ShowS
showList :: [GetHieAst] -> ShowS
Show, Typeable, (forall x. GetHieAst -> Rep GetHieAst x)
-> (forall x. Rep GetHieAst x -> GetHieAst) -> Generic GetHieAst
forall x. Rep GetHieAst x -> GetHieAst
forall x. GetHieAst -> Rep GetHieAst x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetHieAst -> Rep GetHieAst x
from :: forall x. GetHieAst -> Rep GetHieAst x
$cto :: forall x. Rep GetHieAst x -> GetHieAst
to :: forall x. Rep GetHieAst x -> GetHieAst
Generic)
instance Hashable GetHieAst
instance NFData GetHieAst
data GetBindings = GetBindings
deriving (GetBindings -> GetBindings -> Bool
(GetBindings -> GetBindings -> Bool)
-> (GetBindings -> GetBindings -> Bool) -> Eq GetBindings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetBindings -> GetBindings -> Bool
== :: GetBindings -> GetBindings -> Bool
$c/= :: GetBindings -> GetBindings -> Bool
/= :: GetBindings -> GetBindings -> Bool
Eq, Int -> GetBindings -> ShowS
[GetBindings] -> ShowS
GetBindings -> String
(Int -> GetBindings -> ShowS)
-> (GetBindings -> String)
-> ([GetBindings] -> ShowS)
-> Show GetBindings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetBindings -> ShowS
showsPrec :: Int -> GetBindings -> ShowS
$cshow :: GetBindings -> String
show :: GetBindings -> String
$cshowList :: [GetBindings] -> ShowS
showList :: [GetBindings] -> ShowS
Show, Typeable, (forall x. GetBindings -> Rep GetBindings x)
-> (forall x. Rep GetBindings x -> GetBindings)
-> Generic GetBindings
forall x. Rep GetBindings x -> GetBindings
forall x. GetBindings -> Rep GetBindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetBindings -> Rep GetBindings x
from :: forall x. GetBindings -> Rep GetBindings x
$cto :: forall x. Rep GetBindings x -> GetBindings
to :: forall x. Rep GetBindings x -> GetBindings
Generic)
instance Hashable GetBindings
instance NFData GetBindings
data GhcSession = GhcSession
deriving (GhcSession -> GhcSession -> Bool
(GhcSession -> GhcSession -> Bool)
-> (GhcSession -> GhcSession -> Bool) -> Eq GhcSession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcSession -> GhcSession -> Bool
== :: GhcSession -> GhcSession -> Bool
$c/= :: GhcSession -> GhcSession -> Bool
/= :: GhcSession -> GhcSession -> Bool
Eq, Int -> GhcSession -> ShowS
[GhcSession] -> ShowS
GhcSession -> String
(Int -> GhcSession -> ShowS)
-> (GhcSession -> String)
-> ([GhcSession] -> ShowS)
-> Show GhcSession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcSession -> ShowS
showsPrec :: Int -> GhcSession -> ShowS
$cshow :: GhcSession -> String
show :: GhcSession -> String
$cshowList :: [GhcSession] -> ShowS
showList :: [GhcSession] -> ShowS
Show, Typeable, (forall x. GhcSession -> Rep GhcSession x)
-> (forall x. Rep GhcSession x -> GhcSession) -> Generic GhcSession
forall x. Rep GhcSession x -> GhcSession
forall x. GhcSession -> Rep GhcSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhcSession -> Rep GhcSession x
from :: forall x. GhcSession -> Rep GhcSession x
$cto :: forall x. Rep GhcSession x -> GhcSession
to :: forall x. Rep GhcSession x -> GhcSession
Generic)
instance Hashable GhcSession
instance NFData GhcSession
newtype GhcSessionDeps = GhcSessionDeps_
{
GhcSessionDeps -> Bool
fullModSummary :: Bool
}
deriving newtype (GhcSessionDeps -> GhcSessionDeps -> Bool
(GhcSessionDeps -> GhcSessionDeps -> Bool)
-> (GhcSessionDeps -> GhcSessionDeps -> Bool) -> Eq GhcSessionDeps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcSessionDeps -> GhcSessionDeps -> Bool
== :: GhcSessionDeps -> GhcSessionDeps -> Bool
$c/= :: GhcSessionDeps -> GhcSessionDeps -> Bool
/= :: GhcSessionDeps -> GhcSessionDeps -> Bool
Eq, Typeable, Eq GhcSessionDeps
Eq GhcSessionDeps =>
(Int -> GhcSessionDeps -> Int)
-> (GhcSessionDeps -> Int) -> Hashable GhcSessionDeps
Int -> GhcSessionDeps -> Int
GhcSessionDeps -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GhcSessionDeps -> Int
hashWithSalt :: Int -> GhcSessionDeps -> Int
$chash :: GhcSessionDeps -> Int
hash :: GhcSessionDeps -> Int
Hashable, GhcSessionDeps -> ()
(GhcSessionDeps -> ()) -> NFData GhcSessionDeps
forall a. (a -> ()) -> NFData a
$crnf :: GhcSessionDeps -> ()
rnf :: GhcSessionDeps -> ()
NFData)
instance Show GhcSessionDeps where
show :: GhcSessionDeps -> String
show (GhcSessionDeps_ Bool
False) = String
"GhcSessionDeps"
show (GhcSessionDeps_ Bool
True) = String
"GhcSessionDepsFull"
pattern GhcSessionDeps :: GhcSessionDeps
pattern $mGhcSessionDeps :: forall {r}. GhcSessionDeps -> ((# #) -> r) -> ((# #) -> r) -> r
$bGhcSessionDeps :: GhcSessionDeps
GhcSessionDeps = GhcSessionDeps_ False
data GetModIfaceFromDisk = GetModIfaceFromDisk
deriving (GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
(GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool)
-> (GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool)
-> Eq GetModIfaceFromDisk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
== :: GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
$c/= :: GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
/= :: GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
Eq, Int -> GetModIfaceFromDisk -> ShowS
[GetModIfaceFromDisk] -> ShowS
GetModIfaceFromDisk -> String
(Int -> GetModIfaceFromDisk -> ShowS)
-> (GetModIfaceFromDisk -> String)
-> ([GetModIfaceFromDisk] -> ShowS)
-> Show GetModIfaceFromDisk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetModIfaceFromDisk -> ShowS
showsPrec :: Int -> GetModIfaceFromDisk -> ShowS
$cshow :: GetModIfaceFromDisk -> String
show :: GetModIfaceFromDisk -> String
$cshowList :: [GetModIfaceFromDisk] -> ShowS
showList :: [GetModIfaceFromDisk] -> ShowS
Show, Typeable, (forall x. GetModIfaceFromDisk -> Rep GetModIfaceFromDisk x)
-> (forall x. Rep GetModIfaceFromDisk x -> GetModIfaceFromDisk)
-> Generic GetModIfaceFromDisk
forall x. Rep GetModIfaceFromDisk x -> GetModIfaceFromDisk
forall x. GetModIfaceFromDisk -> Rep GetModIfaceFromDisk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetModIfaceFromDisk -> Rep GetModIfaceFromDisk x
from :: forall x. GetModIfaceFromDisk -> Rep GetModIfaceFromDisk x
$cto :: forall x. Rep GetModIfaceFromDisk x -> GetModIfaceFromDisk
to :: forall x. Rep GetModIfaceFromDisk x -> GetModIfaceFromDisk
Generic)
instance Hashable GetModIfaceFromDisk
instance NFData GetModIfaceFromDisk
data GetModIfaceFromDiskAndIndex = GetModIfaceFromDiskAndIndex
deriving (GetModIfaceFromDiskAndIndex -> GetModIfaceFromDiskAndIndex -> Bool
(GetModIfaceFromDiskAndIndex
-> GetModIfaceFromDiskAndIndex -> Bool)
-> (GetModIfaceFromDiskAndIndex
-> GetModIfaceFromDiskAndIndex -> Bool)
-> Eq GetModIfaceFromDiskAndIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetModIfaceFromDiskAndIndex -> GetModIfaceFromDiskAndIndex -> Bool
== :: GetModIfaceFromDiskAndIndex -> GetModIfaceFromDiskAndIndex -> Bool
$c/= :: GetModIfaceFromDiskAndIndex -> GetModIfaceFromDiskAndIndex -> Bool
/= :: GetModIfaceFromDiskAndIndex -> GetModIfaceFromDiskAndIndex -> Bool
Eq, Int -> GetModIfaceFromDiskAndIndex -> ShowS
[GetModIfaceFromDiskAndIndex] -> ShowS
GetModIfaceFromDiskAndIndex -> String
(Int -> GetModIfaceFromDiskAndIndex -> ShowS)
-> (GetModIfaceFromDiskAndIndex -> String)
-> ([GetModIfaceFromDiskAndIndex] -> ShowS)
-> Show GetModIfaceFromDiskAndIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetModIfaceFromDiskAndIndex -> ShowS
showsPrec :: Int -> GetModIfaceFromDiskAndIndex -> ShowS
$cshow :: GetModIfaceFromDiskAndIndex -> String
show :: GetModIfaceFromDiskAndIndex -> String
$cshowList :: [GetModIfaceFromDiskAndIndex] -> ShowS
showList :: [GetModIfaceFromDiskAndIndex] -> ShowS
Show, Typeable, (forall x.
GetModIfaceFromDiskAndIndex -> Rep GetModIfaceFromDiskAndIndex x)
-> (forall x.
Rep GetModIfaceFromDiskAndIndex x -> GetModIfaceFromDiskAndIndex)
-> Generic GetModIfaceFromDiskAndIndex
forall x.
Rep GetModIfaceFromDiskAndIndex x -> GetModIfaceFromDiskAndIndex
forall x.
GetModIfaceFromDiskAndIndex -> Rep GetModIfaceFromDiskAndIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetModIfaceFromDiskAndIndex -> Rep GetModIfaceFromDiskAndIndex x
from :: forall x.
GetModIfaceFromDiskAndIndex -> Rep GetModIfaceFromDiskAndIndex x
$cto :: forall x.
Rep GetModIfaceFromDiskAndIndex x -> GetModIfaceFromDiskAndIndex
to :: forall x.
Rep GetModIfaceFromDiskAndIndex x -> GetModIfaceFromDiskAndIndex
Generic)
instance Hashable GetModIfaceFromDiskAndIndex
instance NFData GetModIfaceFromDiskAndIndex
data GetModIface = GetModIface
deriving (GetModIface -> GetModIface -> Bool
(GetModIface -> GetModIface -> Bool)
-> (GetModIface -> GetModIface -> Bool) -> Eq GetModIface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetModIface -> GetModIface -> Bool
== :: GetModIface -> GetModIface -> Bool
$c/= :: GetModIface -> GetModIface -> Bool
/= :: GetModIface -> GetModIface -> Bool
Eq, Int -> GetModIface -> ShowS
[GetModIface] -> ShowS
GetModIface -> String
(Int -> GetModIface -> ShowS)
-> (GetModIface -> String)
-> ([GetModIface] -> ShowS)
-> Show GetModIface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetModIface -> ShowS
showsPrec :: Int -> GetModIface -> ShowS
$cshow :: GetModIface -> String
show :: GetModIface -> String
$cshowList :: [GetModIface] -> ShowS
showList :: [GetModIface] -> ShowS
Show, Typeable, (forall x. GetModIface -> Rep GetModIface x)
-> (forall x. Rep GetModIface x -> GetModIface)
-> Generic GetModIface
forall x. Rep GetModIface x -> GetModIface
forall x. GetModIface -> Rep GetModIface x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetModIface -> Rep GetModIface x
from :: forall x. GetModIface -> Rep GetModIface x
$cto :: forall x. Rep GetModIface x -> GetModIface
to :: forall x. Rep GetModIface x -> GetModIface
Generic)
instance Hashable GetModIface
instance NFData GetModIface
data IsFileOfInterest = IsFileOfInterest
deriving (IsFileOfInterest -> IsFileOfInterest -> Bool
(IsFileOfInterest -> IsFileOfInterest -> Bool)
-> (IsFileOfInterest -> IsFileOfInterest -> Bool)
-> Eq IsFileOfInterest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsFileOfInterest -> IsFileOfInterest -> Bool
== :: IsFileOfInterest -> IsFileOfInterest -> Bool
$c/= :: IsFileOfInterest -> IsFileOfInterest -> Bool
/= :: IsFileOfInterest -> IsFileOfInterest -> Bool
Eq, Int -> IsFileOfInterest -> ShowS
[IsFileOfInterest] -> ShowS
IsFileOfInterest -> String
(Int -> IsFileOfInterest -> ShowS)
-> (IsFileOfInterest -> String)
-> ([IsFileOfInterest] -> ShowS)
-> Show IsFileOfInterest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsFileOfInterest -> ShowS
showsPrec :: Int -> IsFileOfInterest -> ShowS
$cshow :: IsFileOfInterest -> String
show :: IsFileOfInterest -> String
$cshowList :: [IsFileOfInterest] -> ShowS
showList :: [IsFileOfInterest] -> ShowS
Show, Typeable, (forall x. IsFileOfInterest -> Rep IsFileOfInterest x)
-> (forall x. Rep IsFileOfInterest x -> IsFileOfInterest)
-> Generic IsFileOfInterest
forall x. Rep IsFileOfInterest x -> IsFileOfInterest
forall x. IsFileOfInterest -> Rep IsFileOfInterest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsFileOfInterest -> Rep IsFileOfInterest x
from :: forall x. IsFileOfInterest -> Rep IsFileOfInterest x
$cto :: forall x. Rep IsFileOfInterest x -> IsFileOfInterest
to :: forall x. Rep IsFileOfInterest x -> IsFileOfInterest
Generic)
instance Hashable IsFileOfInterest
instance NFData IsFileOfInterest
data GetModSummaryWithoutTimestamps = GetModSummaryWithoutTimestamps
deriving (GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
(GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool)
-> (GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool)
-> Eq GetModSummaryWithoutTimestamps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
== :: GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
$c/= :: GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
/= :: GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
Eq, Int -> GetModSummaryWithoutTimestamps -> ShowS
[GetModSummaryWithoutTimestamps] -> ShowS
GetModSummaryWithoutTimestamps -> String
(Int -> GetModSummaryWithoutTimestamps -> ShowS)
-> (GetModSummaryWithoutTimestamps -> String)
-> ([GetModSummaryWithoutTimestamps] -> ShowS)
-> Show GetModSummaryWithoutTimestamps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetModSummaryWithoutTimestamps -> ShowS
showsPrec :: Int -> GetModSummaryWithoutTimestamps -> ShowS
$cshow :: GetModSummaryWithoutTimestamps -> String
show :: GetModSummaryWithoutTimestamps -> String
$cshowList :: [GetModSummaryWithoutTimestamps] -> ShowS
showList :: [GetModSummaryWithoutTimestamps] -> ShowS
Show, Typeable, (forall x.
GetModSummaryWithoutTimestamps
-> Rep GetModSummaryWithoutTimestamps x)
-> (forall x.
Rep GetModSummaryWithoutTimestamps x
-> GetModSummaryWithoutTimestamps)
-> Generic GetModSummaryWithoutTimestamps
forall x.
Rep GetModSummaryWithoutTimestamps x
-> GetModSummaryWithoutTimestamps
forall x.
GetModSummaryWithoutTimestamps
-> Rep GetModSummaryWithoutTimestamps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetModSummaryWithoutTimestamps
-> Rep GetModSummaryWithoutTimestamps x
from :: forall x.
GetModSummaryWithoutTimestamps
-> Rep GetModSummaryWithoutTimestamps x
$cto :: forall x.
Rep GetModSummaryWithoutTimestamps x
-> GetModSummaryWithoutTimestamps
to :: forall x.
Rep GetModSummaryWithoutTimestamps x
-> GetModSummaryWithoutTimestamps
Generic)
instance Hashable GetModSummaryWithoutTimestamps
instance NFData GetModSummaryWithoutTimestamps
data GetModSummary = GetModSummary
deriving (GetModSummary -> GetModSummary -> Bool
(GetModSummary -> GetModSummary -> Bool)
-> (GetModSummary -> GetModSummary -> Bool) -> Eq GetModSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetModSummary -> GetModSummary -> Bool
== :: GetModSummary -> GetModSummary -> Bool
$c/= :: GetModSummary -> GetModSummary -> Bool
/= :: GetModSummary -> GetModSummary -> Bool
Eq, Int -> GetModSummary -> ShowS
[GetModSummary] -> ShowS
GetModSummary -> String
(Int -> GetModSummary -> ShowS)
-> (GetModSummary -> String)
-> ([GetModSummary] -> ShowS)
-> Show GetModSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetModSummary -> ShowS
showsPrec :: Int -> GetModSummary -> ShowS
$cshow :: GetModSummary -> String
show :: GetModSummary -> String
$cshowList :: [GetModSummary] -> ShowS
showList :: [GetModSummary] -> ShowS
Show, Typeable, (forall x. GetModSummary -> Rep GetModSummary x)
-> (forall x. Rep GetModSummary x -> GetModSummary)
-> Generic GetModSummary
forall x. Rep GetModSummary x -> GetModSummary
forall x. GetModSummary -> Rep GetModSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetModSummary -> Rep GetModSummary x
from :: forall x. GetModSummary -> Rep GetModSummary x
$cto :: forall x. Rep GetModSummary x -> GetModSummary
to :: forall x. Rep GetModSummary x -> GetModSummary
Generic)
instance Hashable GetModSummary
instance NFData GetModSummary
data GetClientSettings = GetClientSettings
deriving (GetClientSettings -> GetClientSettings -> Bool
(GetClientSettings -> GetClientSettings -> Bool)
-> (GetClientSettings -> GetClientSettings -> Bool)
-> Eq GetClientSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetClientSettings -> GetClientSettings -> Bool
== :: GetClientSettings -> GetClientSettings -> Bool
$c/= :: GetClientSettings -> GetClientSettings -> Bool
/= :: GetClientSettings -> GetClientSettings -> Bool
Eq, Int -> GetClientSettings -> ShowS
[GetClientSettings] -> ShowS
GetClientSettings -> String
(Int -> GetClientSettings -> ShowS)
-> (GetClientSettings -> String)
-> ([GetClientSettings] -> ShowS)
-> Show GetClientSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetClientSettings -> ShowS
showsPrec :: Int -> GetClientSettings -> ShowS
$cshow :: GetClientSettings -> String
show :: GetClientSettings -> String
$cshowList :: [GetClientSettings] -> ShowS
showList :: [GetClientSettings] -> ShowS
Show, Typeable, (forall x. GetClientSettings -> Rep GetClientSettings x)
-> (forall x. Rep GetClientSettings x -> GetClientSettings)
-> Generic GetClientSettings
forall x. Rep GetClientSettings x -> GetClientSettings
forall x. GetClientSettings -> Rep GetClientSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetClientSettings -> Rep GetClientSettings x
from :: forall x. GetClientSettings -> Rep GetClientSettings x
$cto :: forall x. Rep GetClientSettings x -> GetClientSettings
to :: forall x. Rep GetClientSettings x -> GetClientSettings
Generic)
instance Hashable GetClientSettings
instance NFData GetClientSettings
type instance RuleResult GetClientSettings = Hashed (Maybe Value)
data AddWatchedFile = AddWatchedFile deriving (AddWatchedFile -> AddWatchedFile -> Bool
(AddWatchedFile -> AddWatchedFile -> Bool)
-> (AddWatchedFile -> AddWatchedFile -> Bool) -> Eq AddWatchedFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddWatchedFile -> AddWatchedFile -> Bool
== :: AddWatchedFile -> AddWatchedFile -> Bool
$c/= :: AddWatchedFile -> AddWatchedFile -> Bool
/= :: AddWatchedFile -> AddWatchedFile -> Bool
Eq, Int -> AddWatchedFile -> ShowS
[AddWatchedFile] -> ShowS
AddWatchedFile -> String
(Int -> AddWatchedFile -> ShowS)
-> (AddWatchedFile -> String)
-> ([AddWatchedFile] -> ShowS)
-> Show AddWatchedFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddWatchedFile -> ShowS
showsPrec :: Int -> AddWatchedFile -> ShowS
$cshow :: AddWatchedFile -> String
show :: AddWatchedFile -> String
$cshowList :: [AddWatchedFile] -> ShowS
showList :: [AddWatchedFile] -> ShowS
Show, Typeable, (forall x. AddWatchedFile -> Rep AddWatchedFile x)
-> (forall x. Rep AddWatchedFile x -> AddWatchedFile)
-> Generic AddWatchedFile
forall x. Rep AddWatchedFile x -> AddWatchedFile
forall x. AddWatchedFile -> Rep AddWatchedFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddWatchedFile -> Rep AddWatchedFile x
from :: forall x. AddWatchedFile -> Rep AddWatchedFile x
$cto :: forall x. Rep AddWatchedFile x -> AddWatchedFile
to :: forall x. Rep AddWatchedFile x -> AddWatchedFile
Generic)
instance Hashable AddWatchedFile
instance NFData AddWatchedFile
type instance RuleResult GhcSessionIO = IdeGhcSession
data IdeGhcSession = IdeGhcSession
{ IdeGhcSession -> String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
, IdeGhcSession -> Int
sessionVersion :: !Int
}
instance Show IdeGhcSession where show :: IdeGhcSession -> String
show IdeGhcSession
_ = String
"IdeGhcSession"
instance NFData IdeGhcSession where rnf :: IdeGhcSession -> ()
rnf !IdeGhcSession
_ = ()
data GhcSessionIO = GhcSessionIO deriving (GhcSessionIO -> GhcSessionIO -> Bool
(GhcSessionIO -> GhcSessionIO -> Bool)
-> (GhcSessionIO -> GhcSessionIO -> Bool) -> Eq GhcSessionIO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcSessionIO -> GhcSessionIO -> Bool
== :: GhcSessionIO -> GhcSessionIO -> Bool
$c/= :: GhcSessionIO -> GhcSessionIO -> Bool
/= :: GhcSessionIO -> GhcSessionIO -> Bool
Eq, Int -> GhcSessionIO -> ShowS
[GhcSessionIO] -> ShowS
GhcSessionIO -> String
(Int -> GhcSessionIO -> ShowS)
-> (GhcSessionIO -> String)
-> ([GhcSessionIO] -> ShowS)
-> Show GhcSessionIO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcSessionIO -> ShowS
showsPrec :: Int -> GhcSessionIO -> ShowS
$cshow :: GhcSessionIO -> String
show :: GhcSessionIO -> String
$cshowList :: [GhcSessionIO] -> ShowS
showList :: [GhcSessionIO] -> ShowS
Show, Typeable, (forall x. GhcSessionIO -> Rep GhcSessionIO x)
-> (forall x. Rep GhcSessionIO x -> GhcSessionIO)
-> Generic GhcSessionIO
forall x. Rep GhcSessionIO x -> GhcSessionIO
forall x. GhcSessionIO -> Rep GhcSessionIO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhcSessionIO -> Rep GhcSessionIO x
from :: forall x. GhcSessionIO -> Rep GhcSessionIO x
$cto :: forall x. Rep GhcSessionIO x -> GhcSessionIO
to :: forall x. Rep GhcSessionIO x -> GhcSessionIO
Generic)
instance Hashable GhcSessionIO
instance NFData GhcSessionIO
makeLensesWith
(lensRules & lensField .~ mappingNamer (pure . (++ "L")))
''Splices