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

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}

-- | A Shake implementation of the compiler service, built
--   using the "Shaker" abstraction layer for in-memory use.
--
module Development.IDE.Core.RuleTypes(
    module Development.IDE.Core.RuleTypes
    ) where

import           Control.DeepSeq
import Data.Aeson.Types (Value)
import Data.Binary
import           Development.IDE.Import.DependencyInformation
import Development.IDE.GHC.Compat hiding (HieFileResult)
import Development.IDE.GHC.Util
import Development.IDE.Types.KnownTargets
import           Data.Hashable
import           Data.Typeable
import qualified Data.Set as S
import qualified Data.Map as M
import           Development.Shake
import           GHC.Generics                             (Generic)

import Module (InstalledUnitId)
import HscTypes (ModGuts, hm_iface, HomeModInfo, hm_linkable)

import           Development.IDE.Spans.Common
import           Development.IDE.Spans.LocalBindings
import           Development.IDE.Import.FindImports (ArtifactsLocation)
import Data.ByteString (ByteString)
import Language.Haskell.LSP.Types (NormalizedFilePath)
import TcRnMonad (TcGblEnv)
import qualified Data.ByteString.Char8 as BS
import Development.IDE.Types.Options (IdeGhcSession)

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
/= :: LinkableType -> LinkableType -> Bool
$c/= :: LinkableType -> LinkableType -> Bool
== :: LinkableType -> LinkableType -> Bool
$c== :: 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
min :: LinkableType -> LinkableType -> LinkableType
$cmin :: LinkableType -> LinkableType -> LinkableType
max :: LinkableType -> LinkableType -> LinkableType
$cmax :: LinkableType -> LinkableType -> LinkableType
>= :: LinkableType -> LinkableType -> Bool
$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
compare :: LinkableType -> LinkableType -> Ordering
$ccompare :: LinkableType -> LinkableType -> Ordering
$cp1Ord :: Eq 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
showList :: [LinkableType] -> ShowS
$cshowList :: [LinkableType] -> ShowS
show :: LinkableType -> String
$cshow :: LinkableType -> String
showsPrec :: Int -> LinkableType -> ShowS
$cshowsPrec :: Int -> LinkableType -> ShowS
Show)

-- NOTATION
--   Foo+ means Foo for the dependencies
--   Foo* means Foo for me and Foo+

-- | The parse tree for the file using GetFileContents
type instance RuleResult GetParsedModule = ParsedModule

-- | The dependency information produced by following the imports recursively.
-- This rule will succeed even if there is an error, e.g., a module could not be located,
-- a module could not be parsed or an import cycle.
type instance RuleResult GetDependencyInformation = DependencyInformation

-- | Transitive module and pkg dependencies based on the information produced by GetDependencyInformation.
-- This rule is also responsible for calling ReportImportCycles for each file in the transitive closure.
type instance RuleResult GetDependencies = TransitiveDependencies

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
showList :: [GetKnownTargets] -> ShowS
$cshowList :: [GetKnownTargets] -> ShowS
show :: GetKnownTargets -> String
$cshow :: GetKnownTargets -> String
showsPrec :: Int -> GetKnownTargets -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetKnownTargets x -> GetKnownTargets
$cfrom :: forall x. GetKnownTargets -> Rep GetKnownTargets x
Generic, GetKnownTargets -> GetKnownTargets -> Bool
(GetKnownTargets -> GetKnownTargets -> Bool)
-> (GetKnownTargets -> GetKnownTargets -> Bool)
-> Eq GetKnownTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetKnownTargets -> GetKnownTargets -> Bool
$c/= :: GetKnownTargets -> GetKnownTargets -> Bool
== :: GetKnownTargets -> GetKnownTargets -> Bool
$c== :: 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
min :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
$cmin :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
max :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
$cmax :: GetKnownTargets -> GetKnownTargets -> GetKnownTargets
>= :: GetKnownTargets -> GetKnownTargets -> Bool
$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
compare :: GetKnownTargets -> GetKnownTargets -> Ordering
$ccompare :: GetKnownTargets -> GetKnownTargets -> Ordering
$cp1Ord :: Eq GetKnownTargets
Ord)
instance Hashable GetKnownTargets
instance NFData   GetKnownTargets
instance Binary   GetKnownTargets
type instance RuleResult GetKnownTargets = KnownTargets

-- | Convert to Core, requires TypeCheck*
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
/= :: GenerateCore -> GenerateCore -> Bool
$c/= :: GenerateCore -> GenerateCore -> Bool
== :: GenerateCore -> GenerateCore -> Bool
$c== :: 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
showList :: [GenerateCore] -> ShowS
$cshowList :: [GenerateCore] -> ShowS
show :: GenerateCore -> String
$cshow :: GenerateCore -> String
showsPrec :: Int -> GenerateCore -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GenerateCore x -> GenerateCore
$cfrom :: forall x. GenerateCore -> Rep GenerateCore x
Generic)
instance Hashable GenerateCore
instance NFData   GenerateCore
instance Binary   GenerateCore

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
/= :: GetImportMap -> GetImportMap -> Bool
$c/= :: GetImportMap -> GetImportMap -> Bool
== :: GetImportMap -> GetImportMap -> Bool
$c== :: 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
showList :: [GetImportMap] -> ShowS
$cshowList :: [GetImportMap] -> ShowS
show :: GetImportMap -> String
$cshow :: GetImportMap -> String
showsPrec :: Int -> GetImportMap -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetImportMap x -> GetImportMap
$cfrom :: forall x. GetImportMap -> Rep GetImportMap x
Generic)
instance Hashable GetImportMap
instance NFData   GetImportMap
instance Binary   GetImportMap

type instance RuleResult GetImportMap = ImportMap
newtype ImportMap = ImportMap
  { ImportMap -> Map ModuleName NormalizedFilePath
importMap :: M.Map ModuleName NormalizedFilePath -- ^ Where are the modules imported by this file located?
  } 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
showList :: [ImportMap] -> ShowS
$cshowList :: [ImportMap] -> ShowS
show :: ImportMap -> String
$cshow :: ImportMap -> String
showsPrec :: Int -> ImportMap -> ShowS
$cshowsPrec :: Int -> ImportMap -> ShowS
Show
    deriving newtype ImportMap -> ()
(ImportMap -> ()) -> NFData ImportMap
forall a. (a -> ()) -> NFData a
rnf :: ImportMap -> ()
$crnf :: ImportMap -> ()
NFData

-- | Contains the typechecked module and the OrigNameCache entry for
-- that module.
data TcModuleResult = TcModuleResult
    { TcModuleResult -> ParsedModule
tmrParsed :: ParsedModule
    , TcModuleResult -> RenamedSource
tmrRenamed :: RenamedSource
    , TcModuleResult -> TcGblEnv
tmrTypechecked :: TcGblEnv
    , TcModuleResult -> Bool
tmrDeferedError :: !Bool -- ^ Did we defer any type errors for this module?
    }
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
    -- Bang patterns here are important to stop the result retaining
    -- a reference to a typechecked module
    , HiFileResult -> HomeModInfo
hirHomeMod :: !HomeModInfo
    -- ^ Includes the Linkable iff we need object files
    }

hiFileFingerPrint :: HiFileResult -> ByteString
hiFileFingerPrint :: HiFileResult -> ByteString
hiFileFingerPrint HiFileResult
hfr = ByteString
ifaceBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
linkableBS
  where
    ifaceBS :: ByteString
ifaceBS = Fingerprint -> ByteString
fingerprintToBS (Fingerprint -> ByteString)
-> (HiFileResult -> Fingerprint) -> HiFileResult -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Fingerprint
getModuleHash (ModIface -> Fingerprint)
-> (HiFileResult -> ModIface) -> HiFileResult -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HiFileResult -> ModIface
hirModIface (HiFileResult -> ByteString) -> HiFileResult -> ByteString
forall a b. (a -> b) -> a -> b
$ HiFileResult
hfr -- will always be two bytes
    linkableBS :: ByteString
linkableBS = case HomeModInfo -> Maybe Linkable
hm_linkable (HomeModInfo -> Maybe Linkable) -> HomeModInfo -> Maybe Linkable
forall a b. (a -> b) -> a -> b
$ HiFileResult -> HomeModInfo
hirHomeMod HiFileResult
hfr of
      Maybe Linkable
Nothing -> ByteString
""
      Just Linkable
l -> String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall a. Show a => a -> String
show (UTCTime -> String) -> UTCTime -> String
forall a b. (a -> b) -> a -> b
$ Linkable -> UTCTime
linkableTime Linkable
l

hirModIface :: HiFileResult -> ModIface
hirModIface :: HiFileResult -> ModIface
hirModIface = HomeModInfo -> ModIface
hm_iface (HomeModInfo -> ModIface)
-> (HiFileResult -> HomeModInfo) -> HiFileResult -> ModIface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HiFileResult -> HomeModInfo
hirHomeMod

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

-- | Save the uncompressed AST here, we compress it just before writing to disk
data HieAstResult
  = HAR
  { HieAstResult -> Module
hieModule :: Module
  , HieAstResult -> HieASTs Type
hieAst :: !(HieASTs Type)
  , HieAstResult -> RefMap
refMap :: RefMap
  -- ^ Lazy because its value only depends on the hieAst, which is bundled in this type
  -- Lazyness can't cause leaks here because the lifetime of `refMap` will be the same
  -- as that of `hieAst`
  }

instance NFData HieAstResult where
    rnf :: HieAstResult -> ()
rnf (HAR Module
m HieASTs Type
hf RefMap
_rm) = Module -> ()
forall a. NFData a => a -> ()
rnf Module
m () -> () -> ()
`seq` HieASTs Type -> ()
forall a. a -> ()
rwhnf HieASTs Type
hf

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

-- | The type checked version of this file, requires TypeCheck+
type instance RuleResult TypeCheck = TcModuleResult

-- | The uncompressed HieAST
type instance RuleResult GetHieAst = HieAstResult

-- | A IntervalMap telling us what is in scope at each point
type instance RuleResult GetBindings = Bindings

data DocAndKindMap = DKMap {DocAndKindMap -> DocMap
getDocMap :: !DocMap, DocAndKindMap -> KindMap
getKindMap :: !KindMap}
instance NFData DocAndKindMap where
    rnf :: DocAndKindMap -> ()
rnf (DKMap DocMap
a KindMap
b) = DocMap -> ()
forall a. a -> ()
rwhnf DocMap
a () -> () -> ()
`seq` KindMap -> ()
forall a. a -> ()
rwhnf KindMap
b

instance Show DocAndKindMap where
    show :: DocAndKindMap -> String
show = String -> DocAndKindMap -> String
forall a b. a -> b -> a
const String
"docmap"

type instance RuleResult GetDocMap = DocAndKindMap

-- | A GHC session that we reuse.
type instance RuleResult GhcSession = HscEnvEq

-- | A GHC session preloaded with all the dependencies
type instance RuleResult GhcSessionDeps = HscEnvEq

-- | Resolve the imports in a module to the file path of a module
-- in the same package or the package id of another package.
type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe ArtifactsLocation)], S.Set InstalledUnitId)

-- | This rule is used to report import cycles. It depends on GetDependencyInformation.
-- We cannot report the cycles directly from GetDependencyInformation since
-- we can only report diagnostics for the current file.
type instance RuleResult ReportImportCycles = ()

-- | Read the module interface file from disk. Throws an error for VFS files.
--   This is an internal rule, use 'GetModIface' instead.
type instance RuleResult GetModIfaceFromDisk = HiFileResult

-- | Get a module interface details, either from an interface file or a typechecked module
type instance RuleResult GetModIface = HiFileResult

-- | Get a module interface details, without the Linkable
-- For better early cuttoff
type instance RuleResult GetModIfaceWithoutLinkable = HiFileResult

data FileOfInterestStatus = OnDisk | Modified
  deriving (FileOfInterestStatus -> FileOfInterestStatus -> Bool
(FileOfInterestStatus -> FileOfInterestStatus -> Bool)
-> (FileOfInterestStatus -> FileOfInterestStatus -> Bool)
-> Eq FileOfInterestStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileOfInterestStatus -> FileOfInterestStatus -> Bool
$c/= :: FileOfInterestStatus -> FileOfInterestStatus -> Bool
== :: FileOfInterestStatus -> FileOfInterestStatus -> Bool
$c== :: 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
showList :: [FileOfInterestStatus] -> ShowS
$cshowList :: [FileOfInterestStatus] -> ShowS
show :: FileOfInterestStatus -> String
$cshow :: FileOfInterestStatus -> String
showsPrec :: Int -> FileOfInterestStatus -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep FileOfInterestStatus x -> FileOfInterestStatus
$cfrom :: forall x. FileOfInterestStatus -> Rep FileOfInterestStatus x
Generic)
instance Hashable FileOfInterestStatus
instance NFData   FileOfInterestStatus
instance Binary   FileOfInterestStatus

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
/= :: IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
$c/= :: IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
== :: IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
$c== :: 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
showList :: [IsFileOfInterestResult] -> ShowS
$cshowList :: [IsFileOfInterestResult] -> ShowS
show :: IsFileOfInterestResult -> String
$cshow :: IsFileOfInterestResult -> String
showsPrec :: Int -> IsFileOfInterestResult -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep IsFileOfInterestResult x -> IsFileOfInterestResult
$cfrom :: forall x. IsFileOfInterestResult -> Rep IsFileOfInterestResult x
Generic)
instance Hashable IsFileOfInterestResult
instance NFData   IsFileOfInterestResult
instance Binary   IsFileOfInterestResult

type instance RuleResult IsFileOfInterest = IsFileOfInterestResult

-- | Generate a ModSummary that has enough information to be used to get .hi and .hie files.
-- without needing to parse the entire source
type instance RuleResult GetModSummary = (ModSummary,[LImportDecl GhcPs])

-- | Generate a ModSummary with the timestamps elided,
--   for more successful early cutoff
type instance RuleResult GetModSummaryWithoutTimestamps = (ModSummary,[LImportDecl GhcPs])

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
/= :: GetParsedModule -> GetParsedModule -> Bool
$c/= :: GetParsedModule -> GetParsedModule -> Bool
== :: GetParsedModule -> GetParsedModule -> Bool
$c== :: 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
showList :: [GetParsedModule] -> ShowS
$cshowList :: [GetParsedModule] -> ShowS
show :: GetParsedModule -> String
$cshow :: GetParsedModule -> String
showsPrec :: Int -> GetParsedModule -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetParsedModule x -> GetParsedModule
$cfrom :: forall x. GetParsedModule -> Rep GetParsedModule x
Generic)
instance Hashable GetParsedModule
instance NFData   GetParsedModule
instance Binary   GetParsedModule

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
/= :: GetLocatedImports -> GetLocatedImports -> Bool
$c/= :: GetLocatedImports -> GetLocatedImports -> Bool
== :: GetLocatedImports -> GetLocatedImports -> Bool
$c== :: 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
showList :: [GetLocatedImports] -> ShowS
$cshowList :: [GetLocatedImports] -> ShowS
show :: GetLocatedImports -> String
$cshow :: GetLocatedImports -> String
showsPrec :: Int -> GetLocatedImports -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetLocatedImports x -> GetLocatedImports
$cfrom :: forall x. GetLocatedImports -> Rep GetLocatedImports x
Generic)
instance Hashable GetLocatedImports
instance NFData   GetLocatedImports
instance Binary   GetLocatedImports

-- | Does this module need to be compiled?
type instance RuleResult NeedsCompilation = Bool

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
/= :: NeedsCompilation -> NeedsCompilation -> Bool
$c/= :: NeedsCompilation -> NeedsCompilation -> Bool
== :: NeedsCompilation -> NeedsCompilation -> Bool
$c== :: 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
showList :: [NeedsCompilation] -> ShowS
$cshowList :: [NeedsCompilation] -> ShowS
show :: NeedsCompilation -> String
$cshow :: NeedsCompilation -> String
showsPrec :: Int -> NeedsCompilation -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep NeedsCompilation x -> NeedsCompilation
$cfrom :: forall x. NeedsCompilation -> Rep NeedsCompilation x
Generic)
instance Hashable NeedsCompilation
instance NFData   NeedsCompilation
instance Binary   NeedsCompilation

data GetDependencyInformation = GetDependencyInformation
    deriving (GetDependencyInformation -> GetDependencyInformation -> Bool
(GetDependencyInformation -> GetDependencyInformation -> Bool)
-> (GetDependencyInformation -> GetDependencyInformation -> Bool)
-> Eq GetDependencyInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDependencyInformation -> GetDependencyInformation -> Bool
$c/= :: GetDependencyInformation -> GetDependencyInformation -> Bool
== :: GetDependencyInformation -> GetDependencyInformation -> Bool
$c== :: GetDependencyInformation -> GetDependencyInformation -> Bool
Eq, Int -> GetDependencyInformation -> ShowS
[GetDependencyInformation] -> ShowS
GetDependencyInformation -> String
(Int -> GetDependencyInformation -> ShowS)
-> (GetDependencyInformation -> String)
-> ([GetDependencyInformation] -> ShowS)
-> Show GetDependencyInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDependencyInformation] -> ShowS
$cshowList :: [GetDependencyInformation] -> ShowS
show :: GetDependencyInformation -> String
$cshow :: GetDependencyInformation -> String
showsPrec :: Int -> GetDependencyInformation -> ShowS
$cshowsPrec :: Int -> GetDependencyInformation -> ShowS
Show, Typeable, (forall x.
 GetDependencyInformation -> Rep GetDependencyInformation x)
-> (forall x.
    Rep GetDependencyInformation x -> GetDependencyInformation)
-> Generic GetDependencyInformation
forall x.
Rep GetDependencyInformation x -> GetDependencyInformation
forall x.
GetDependencyInformation -> Rep GetDependencyInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDependencyInformation x -> GetDependencyInformation
$cfrom :: forall x.
GetDependencyInformation -> Rep GetDependencyInformation x
Generic)
instance Hashable GetDependencyInformation
instance NFData   GetDependencyInformation
instance Binary   GetDependencyInformation

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
/= :: GetModuleGraph -> GetModuleGraph -> Bool
$c/= :: GetModuleGraph -> GetModuleGraph -> Bool
== :: GetModuleGraph -> GetModuleGraph -> Bool
$c== :: 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
showList :: [GetModuleGraph] -> ShowS
$cshowList :: [GetModuleGraph] -> ShowS
show :: GetModuleGraph -> String
$cshow :: GetModuleGraph -> String
showsPrec :: Int -> GetModuleGraph -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetModuleGraph x -> GetModuleGraph
$cfrom :: forall x. GetModuleGraph -> Rep GetModuleGraph x
Generic)
instance Hashable GetModuleGraph
instance NFData   GetModuleGraph
instance Binary   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
/= :: ReportImportCycles -> ReportImportCycles -> Bool
$c/= :: ReportImportCycles -> ReportImportCycles -> Bool
== :: ReportImportCycles -> ReportImportCycles -> Bool
$c== :: 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
showList :: [ReportImportCycles] -> ShowS
$cshowList :: [ReportImportCycles] -> ShowS
show :: ReportImportCycles -> String
$cshow :: ReportImportCycles -> String
showsPrec :: Int -> ReportImportCycles -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ReportImportCycles x -> ReportImportCycles
$cfrom :: forall x. ReportImportCycles -> Rep ReportImportCycles x
Generic)
instance Hashable ReportImportCycles
instance NFData   ReportImportCycles
instance Binary   ReportImportCycles

data GetDependencies = GetDependencies
    deriving (GetDependencies -> GetDependencies -> Bool
(GetDependencies -> GetDependencies -> Bool)
-> (GetDependencies -> GetDependencies -> Bool)
-> Eq GetDependencies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDependencies -> GetDependencies -> Bool
$c/= :: GetDependencies -> GetDependencies -> Bool
== :: GetDependencies -> GetDependencies -> Bool
$c== :: GetDependencies -> GetDependencies -> Bool
Eq, Int -> GetDependencies -> ShowS
[GetDependencies] -> ShowS
GetDependencies -> String
(Int -> GetDependencies -> ShowS)
-> (GetDependencies -> String)
-> ([GetDependencies] -> ShowS)
-> Show GetDependencies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDependencies] -> ShowS
$cshowList :: [GetDependencies] -> ShowS
show :: GetDependencies -> String
$cshow :: GetDependencies -> String
showsPrec :: Int -> GetDependencies -> ShowS
$cshowsPrec :: Int -> GetDependencies -> ShowS
Show, Typeable, (forall x. GetDependencies -> Rep GetDependencies x)
-> (forall x. Rep GetDependencies x -> GetDependencies)
-> Generic GetDependencies
forall x. Rep GetDependencies x -> GetDependencies
forall x. GetDependencies -> Rep GetDependencies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDependencies x -> GetDependencies
$cfrom :: forall x. GetDependencies -> Rep GetDependencies x
Generic)
instance Hashable GetDependencies
instance NFData   GetDependencies
instance Binary   GetDependencies

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
/= :: TypeCheck -> TypeCheck -> Bool
$c/= :: TypeCheck -> TypeCheck -> Bool
== :: TypeCheck -> TypeCheck -> Bool
$c== :: 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
showList :: [TypeCheck] -> ShowS
$cshowList :: [TypeCheck] -> ShowS
show :: TypeCheck -> String
$cshow :: TypeCheck -> String
showsPrec :: Int -> TypeCheck -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep TypeCheck x -> TypeCheck
$cfrom :: forall x. TypeCheck -> Rep TypeCheck x
Generic)
instance Hashable TypeCheck
instance NFData   TypeCheck
instance Binary   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
/= :: GetDocMap -> GetDocMap -> Bool
$c/= :: GetDocMap -> GetDocMap -> Bool
== :: GetDocMap -> GetDocMap -> Bool
$c== :: 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
showList :: [GetDocMap] -> ShowS
$cshowList :: [GetDocMap] -> ShowS
show :: GetDocMap -> String
$cshow :: GetDocMap -> String
showsPrec :: Int -> GetDocMap -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetDocMap x -> GetDocMap
$cfrom :: forall x. GetDocMap -> Rep GetDocMap x
Generic)
instance Hashable GetDocMap
instance NFData   GetDocMap
instance Binary   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
/= :: GetHieAst -> GetHieAst -> Bool
$c/= :: GetHieAst -> GetHieAst -> Bool
== :: GetHieAst -> GetHieAst -> Bool
$c== :: 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
showList :: [GetHieAst] -> ShowS
$cshowList :: [GetHieAst] -> ShowS
show :: GetHieAst -> String
$cshow :: GetHieAst -> String
showsPrec :: Int -> GetHieAst -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetHieAst x -> GetHieAst
$cfrom :: forall x. GetHieAst -> Rep GetHieAst x
Generic)
instance Hashable GetHieAst
instance NFData   GetHieAst
instance Binary   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
/= :: GetBindings -> GetBindings -> Bool
$c/= :: GetBindings -> GetBindings -> Bool
== :: GetBindings -> GetBindings -> Bool
$c== :: 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
showList :: [GetBindings] -> ShowS
$cshowList :: [GetBindings] -> ShowS
show :: GetBindings -> String
$cshow :: GetBindings -> String
showsPrec :: Int -> GetBindings -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetBindings x -> GetBindings
$cfrom :: forall x. GetBindings -> Rep GetBindings x
Generic)
instance Hashable GetBindings
instance NFData   GetBindings
instance Binary   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
/= :: GhcSession -> GhcSession -> Bool
$c/= :: GhcSession -> GhcSession -> Bool
== :: GhcSession -> GhcSession -> Bool
$c== :: 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
showList :: [GhcSession] -> ShowS
$cshowList :: [GhcSession] -> ShowS
show :: GhcSession -> String
$cshow :: GhcSession -> String
showsPrec :: Int -> GhcSession -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GhcSession x -> GhcSession
$cfrom :: forall x. GhcSession -> Rep GhcSession x
Generic)
instance Hashable GhcSession
instance NFData   GhcSession
instance Binary   GhcSession

data GhcSessionDeps = GhcSessionDeps deriving (GhcSessionDeps -> GhcSessionDeps -> Bool
(GhcSessionDeps -> GhcSessionDeps -> Bool)
-> (GhcSessionDeps -> GhcSessionDeps -> Bool) -> Eq GhcSessionDeps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcSessionDeps -> GhcSessionDeps -> Bool
$c/= :: GhcSessionDeps -> GhcSessionDeps -> Bool
== :: GhcSessionDeps -> GhcSessionDeps -> Bool
$c== :: GhcSessionDeps -> GhcSessionDeps -> Bool
Eq, Int -> GhcSessionDeps -> ShowS
[GhcSessionDeps] -> ShowS
GhcSessionDeps -> String
(Int -> GhcSessionDeps -> ShowS)
-> (GhcSessionDeps -> String)
-> ([GhcSessionDeps] -> ShowS)
-> Show GhcSessionDeps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhcSessionDeps] -> ShowS
$cshowList :: [GhcSessionDeps] -> ShowS
show :: GhcSessionDeps -> String
$cshow :: GhcSessionDeps -> String
showsPrec :: Int -> GhcSessionDeps -> ShowS
$cshowsPrec :: Int -> GhcSessionDeps -> ShowS
Show, Typeable, (forall x. GhcSessionDeps -> Rep GhcSessionDeps x)
-> (forall x. Rep GhcSessionDeps x -> GhcSessionDeps)
-> Generic GhcSessionDeps
forall x. Rep GhcSessionDeps x -> GhcSessionDeps
forall x. GhcSessionDeps -> Rep GhcSessionDeps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GhcSessionDeps x -> GhcSessionDeps
$cfrom :: forall x. GhcSessionDeps -> Rep GhcSessionDeps x
Generic)
instance Hashable GhcSessionDeps
instance NFData   GhcSessionDeps
instance Binary   GhcSessionDeps

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
/= :: GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
$c/= :: GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
== :: GetModIfaceFromDisk -> GetModIfaceFromDisk -> Bool
$c== :: 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
showList :: [GetModIfaceFromDisk] -> ShowS
$cshowList :: [GetModIfaceFromDisk] -> ShowS
show :: GetModIfaceFromDisk -> String
$cshow :: GetModIfaceFromDisk -> String
showsPrec :: Int -> GetModIfaceFromDisk -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetModIfaceFromDisk x -> GetModIfaceFromDisk
$cfrom :: forall x. GetModIfaceFromDisk -> Rep GetModIfaceFromDisk x
Generic)
instance Hashable GetModIfaceFromDisk
instance NFData   GetModIfaceFromDisk
instance Binary   GetModIfaceFromDisk

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
/= :: GetModIface -> GetModIface -> Bool
$c/= :: GetModIface -> GetModIface -> Bool
== :: GetModIface -> GetModIface -> Bool
$c== :: 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
showList :: [GetModIface] -> ShowS
$cshowList :: [GetModIface] -> ShowS
show :: GetModIface -> String
$cshow :: GetModIface -> String
showsPrec :: Int -> GetModIface -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetModIface x -> GetModIface
$cfrom :: forall x. GetModIface -> Rep GetModIface x
Generic)
instance Hashable GetModIface
instance NFData   GetModIface
instance Binary   GetModIface

data GetModIfaceWithoutLinkable = GetModIfaceWithoutLinkable
    deriving (GetModIfaceWithoutLinkable -> GetModIfaceWithoutLinkable -> Bool
(GetModIfaceWithoutLinkable -> GetModIfaceWithoutLinkable -> Bool)
-> (GetModIfaceWithoutLinkable
    -> GetModIfaceWithoutLinkable -> Bool)
-> Eq GetModIfaceWithoutLinkable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetModIfaceWithoutLinkable -> GetModIfaceWithoutLinkable -> Bool
$c/= :: GetModIfaceWithoutLinkable -> GetModIfaceWithoutLinkable -> Bool
== :: GetModIfaceWithoutLinkable -> GetModIfaceWithoutLinkable -> Bool
$c== :: GetModIfaceWithoutLinkable -> GetModIfaceWithoutLinkable -> Bool
Eq, Int -> GetModIfaceWithoutLinkable -> ShowS
[GetModIfaceWithoutLinkable] -> ShowS
GetModIfaceWithoutLinkable -> String
(Int -> GetModIfaceWithoutLinkable -> ShowS)
-> (GetModIfaceWithoutLinkable -> String)
-> ([GetModIfaceWithoutLinkable] -> ShowS)
-> Show GetModIfaceWithoutLinkable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetModIfaceWithoutLinkable] -> ShowS
$cshowList :: [GetModIfaceWithoutLinkable] -> ShowS
show :: GetModIfaceWithoutLinkable -> String
$cshow :: GetModIfaceWithoutLinkable -> String
showsPrec :: Int -> GetModIfaceWithoutLinkable -> ShowS
$cshowsPrec :: Int -> GetModIfaceWithoutLinkable -> ShowS
Show, Typeable, (forall x.
 GetModIfaceWithoutLinkable -> Rep GetModIfaceWithoutLinkable x)
-> (forall x.
    Rep GetModIfaceWithoutLinkable x -> GetModIfaceWithoutLinkable)
-> Generic GetModIfaceWithoutLinkable
forall x.
Rep GetModIfaceWithoutLinkable x -> GetModIfaceWithoutLinkable
forall x.
GetModIfaceWithoutLinkable -> Rep GetModIfaceWithoutLinkable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetModIfaceWithoutLinkable x -> GetModIfaceWithoutLinkable
$cfrom :: forall x.
GetModIfaceWithoutLinkable -> Rep GetModIfaceWithoutLinkable x
Generic)
instance Hashable GetModIfaceWithoutLinkable
instance NFData   GetModIfaceWithoutLinkable
instance Binary   GetModIfaceWithoutLinkable

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
/= :: IsFileOfInterest -> IsFileOfInterest -> Bool
$c/= :: IsFileOfInterest -> IsFileOfInterest -> Bool
== :: IsFileOfInterest -> IsFileOfInterest -> Bool
$c== :: 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
showList :: [IsFileOfInterest] -> ShowS
$cshowList :: [IsFileOfInterest] -> ShowS
show :: IsFileOfInterest -> String
$cshow :: IsFileOfInterest -> String
showsPrec :: Int -> IsFileOfInterest -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep IsFileOfInterest x -> IsFileOfInterest
$cfrom :: forall x. IsFileOfInterest -> Rep IsFileOfInterest x
Generic)
instance Hashable IsFileOfInterest
instance NFData   IsFileOfInterest
instance Binary   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
/= :: GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
$c/= :: GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
== :: GetModSummaryWithoutTimestamps
-> GetModSummaryWithoutTimestamps -> Bool
$c== :: 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
showList :: [GetModSummaryWithoutTimestamps] -> ShowS
$cshowList :: [GetModSummaryWithoutTimestamps] -> ShowS
show :: GetModSummaryWithoutTimestamps -> String
$cshow :: GetModSummaryWithoutTimestamps -> String
showsPrec :: Int -> GetModSummaryWithoutTimestamps -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x.
Rep GetModSummaryWithoutTimestamps x
-> GetModSummaryWithoutTimestamps
$cfrom :: forall x.
GetModSummaryWithoutTimestamps
-> Rep GetModSummaryWithoutTimestamps x
Generic)
instance Hashable GetModSummaryWithoutTimestamps
instance NFData   GetModSummaryWithoutTimestamps
instance Binary   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
/= :: GetModSummary -> GetModSummary -> Bool
$c/= :: GetModSummary -> GetModSummary -> Bool
== :: GetModSummary -> GetModSummary -> Bool
$c== :: 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
showList :: [GetModSummary] -> ShowS
$cshowList :: [GetModSummary] -> ShowS
show :: GetModSummary -> String
$cshow :: GetModSummary -> String
showsPrec :: Int -> GetModSummary -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetModSummary x -> GetModSummary
$cfrom :: forall x. GetModSummary -> Rep GetModSummary x
Generic)
instance Hashable GetModSummary
instance NFData   GetModSummary
instance Binary   GetModSummary

-- | Get the vscode client settings stored in the ide state
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
/= :: GetClientSettings -> GetClientSettings -> Bool
$c/= :: GetClientSettings -> GetClientSettings -> Bool
== :: GetClientSettings -> GetClientSettings -> Bool
$c== :: 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
showList :: [GetClientSettings] -> ShowS
$cshowList :: [GetClientSettings] -> ShowS
show :: GetClientSettings -> String
$cshow :: GetClientSettings -> String
showsPrec :: Int -> GetClientSettings -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GetClientSettings x -> GetClientSettings
$cfrom :: forall x. GetClientSettings -> Rep GetClientSettings x
Generic)
instance Hashable GetClientSettings
instance NFData   GetClientSettings
instance Binary   GetClientSettings

type instance RuleResult GetClientSettings = Hashed (Maybe Value)

-- A local rule type to get caching. We want to use newCache, but it has
-- thread killed exception issues, so we lift it to a full rule.
-- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547
type instance RuleResult GhcSessionIO = 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
/= :: GhcSessionIO -> GhcSessionIO -> Bool
$c/= :: GhcSessionIO -> GhcSessionIO -> Bool
== :: GhcSessionIO -> GhcSessionIO -> Bool
$c== :: 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
showList :: [GhcSessionIO] -> ShowS
$cshowList :: [GhcSessionIO] -> ShowS
show :: GhcSessionIO -> String
$cshow :: GhcSessionIO -> String
showsPrec :: Int -> GhcSessionIO -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GhcSessionIO x -> GhcSessionIO
$cfrom :: forall x. GhcSessionIO -> Rep GhcSessionIO x
Generic)
instance Hashable GhcSessionIO
instance NFData   GhcSessionIO
instance Binary   GhcSessionIO