module Development.IDE.Types.Options
( IdeOptions(..)
, IdePreprocessedSource(..)
, IdeReportProgress(..)
, IdeDefer(..)
, IdeTesting(..)
, IdeOTMemoryProfiling(..)
, clientSupportsProgress
, IdePkgLocationOptions(..)
, defaultIdeOptions
, IdeResult
, IdeGhcSession(..)
, OptHaddockParse(..)
, ProgressReportingStyle(..)
) where
import Control.Lens
import qualified Data.Text as T
import Data.Typeable
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat as GHC
import Development.IDE.Graph
import Development.IDE.Types.Diagnostics
import Ide.Plugin.Config
import Ide.Types (DynFlagsModifications)
import qualified Language.LSP.Protocol.Lens as L
import qualified Language.LSP.Protocol.Types as LSP
data IdeOptions = IdeOptions
{ IdeOptions -> ParsedSource -> IdePreprocessedSource
optPreprocessor :: GHC.ParsedSource -> IdePreprocessedSource
, IdeOptions -> Action IdeGhcSession
optGhcSession :: Action IdeGhcSession
, IdeOptions -> IdePkgLocationOptions
optPkgLocationOpts :: IdePkgLocationOptions
, IdeOptions -> [String]
optExtensions :: [String]
, IdeOptions -> Maybe String
optShakeProfiling :: Maybe FilePath
, IdeOptions -> IdeTesting
optTesting :: IdeTesting
, IdeOptions -> IdeReportProgress
optReportProgress :: IdeReportProgress
, IdeOptions -> Int
optMaxDirtyAge :: Int
, IdeOptions -> String
optLanguageSyntax :: String
, IdeOptions -> Bool
optNewColonConvention :: Bool
, IdeOptions -> [Text]
optKeywords :: [T.Text]
, IdeOptions -> IdeDefer
optDefer :: IdeDefer
, IdeOptions -> IO Bool
optCheckProject :: IO Bool
, IdeOptions -> IO CheckParents
optCheckParents :: IO CheckParents
, IdeOptions -> OptHaddockParse
optHaddockParse :: OptHaddockParse
, IdeOptions -> Config -> DynFlagsModifications
optModifyDynFlags :: Config -> DynFlagsModifications
, IdeOptions -> ShakeOptions
optShakeOptions :: ShakeOptions
, IdeOptions -> forall a. Typeable a => a -> Bool
optSkipProgress :: forall a. Typeable a => a -> Bool
, IdeOptions -> ProgressReportingStyle
optProgressStyle :: ProgressReportingStyle
, IdeOptions -> Bool
optRunSubset :: Bool
, IdeOptions -> Bool
optVerifyCoreFile :: Bool
}
data OptHaddockParse = HaddockParse | NoHaddockParse
deriving (OptHaddockParse -> OptHaddockParse -> Bool
(OptHaddockParse -> OptHaddockParse -> Bool)
-> (OptHaddockParse -> OptHaddockParse -> Bool)
-> Eq OptHaddockParse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptHaddockParse -> OptHaddockParse -> Bool
== :: OptHaddockParse -> OptHaddockParse -> Bool
$c/= :: OptHaddockParse -> OptHaddockParse -> Bool
/= :: OptHaddockParse -> OptHaddockParse -> Bool
Eq,Eq OptHaddockParse
Eq OptHaddockParse =>
(OptHaddockParse -> OptHaddockParse -> Ordering)
-> (OptHaddockParse -> OptHaddockParse -> Bool)
-> (OptHaddockParse -> OptHaddockParse -> Bool)
-> (OptHaddockParse -> OptHaddockParse -> Bool)
-> (OptHaddockParse -> OptHaddockParse -> Bool)
-> (OptHaddockParse -> OptHaddockParse -> OptHaddockParse)
-> (OptHaddockParse -> OptHaddockParse -> OptHaddockParse)
-> Ord OptHaddockParse
OptHaddockParse -> OptHaddockParse -> Bool
OptHaddockParse -> OptHaddockParse -> Ordering
OptHaddockParse -> OptHaddockParse -> OptHaddockParse
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 :: OptHaddockParse -> OptHaddockParse -> Ordering
compare :: OptHaddockParse -> OptHaddockParse -> Ordering
$c< :: OptHaddockParse -> OptHaddockParse -> Bool
< :: OptHaddockParse -> OptHaddockParse -> Bool
$c<= :: OptHaddockParse -> OptHaddockParse -> Bool
<= :: OptHaddockParse -> OptHaddockParse -> Bool
$c> :: OptHaddockParse -> OptHaddockParse -> Bool
> :: OptHaddockParse -> OptHaddockParse -> Bool
$c>= :: OptHaddockParse -> OptHaddockParse -> Bool
>= :: OptHaddockParse -> OptHaddockParse -> Bool
$cmax :: OptHaddockParse -> OptHaddockParse -> OptHaddockParse
max :: OptHaddockParse -> OptHaddockParse -> OptHaddockParse
$cmin :: OptHaddockParse -> OptHaddockParse -> OptHaddockParse
min :: OptHaddockParse -> OptHaddockParse -> OptHaddockParse
Ord,Int -> OptHaddockParse -> ShowS
[OptHaddockParse] -> ShowS
OptHaddockParse -> String
(Int -> OptHaddockParse -> ShowS)
-> (OptHaddockParse -> String)
-> ([OptHaddockParse] -> ShowS)
-> Show OptHaddockParse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptHaddockParse -> ShowS
showsPrec :: Int -> OptHaddockParse -> ShowS
$cshow :: OptHaddockParse -> String
show :: OptHaddockParse -> String
$cshowList :: [OptHaddockParse] -> ShowS
showList :: [OptHaddockParse] -> ShowS
Show,Int -> OptHaddockParse
OptHaddockParse -> Int
OptHaddockParse -> [OptHaddockParse]
OptHaddockParse -> OptHaddockParse
OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
OptHaddockParse
-> OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
(OptHaddockParse -> OptHaddockParse)
-> (OptHaddockParse -> OptHaddockParse)
-> (Int -> OptHaddockParse)
-> (OptHaddockParse -> Int)
-> (OptHaddockParse -> [OptHaddockParse])
-> (OptHaddockParse -> OptHaddockParse -> [OptHaddockParse])
-> (OptHaddockParse -> OptHaddockParse -> [OptHaddockParse])
-> (OptHaddockParse
-> OptHaddockParse -> OptHaddockParse -> [OptHaddockParse])
-> Enum OptHaddockParse
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OptHaddockParse -> OptHaddockParse
succ :: OptHaddockParse -> OptHaddockParse
$cpred :: OptHaddockParse -> OptHaddockParse
pred :: OptHaddockParse -> OptHaddockParse
$ctoEnum :: Int -> OptHaddockParse
toEnum :: Int -> OptHaddockParse
$cfromEnum :: OptHaddockParse -> Int
fromEnum :: OptHaddockParse -> Int
$cenumFrom :: OptHaddockParse -> [OptHaddockParse]
enumFrom :: OptHaddockParse -> [OptHaddockParse]
$cenumFromThen :: OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
enumFromThen :: OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
$cenumFromTo :: OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
enumFromTo :: OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
$cenumFromThenTo :: OptHaddockParse
-> OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
enumFromThenTo :: OptHaddockParse
-> OptHaddockParse -> OptHaddockParse -> [OptHaddockParse]
Enum)
data IdePreprocessedSource = IdePreprocessedSource
{ IdePreprocessedSource -> [(SrcSpan, String)]
preprocWarnings :: [(GHC.SrcSpan, String)]
, IdePreprocessedSource -> [(SrcSpan, String)]
preprocErrors :: [(GHC.SrcSpan, String)]
, IdePreprocessedSource -> ParsedSource
preprocSource :: GHC.ParsedSource
}
newtype IdeReportProgress = IdeReportProgress Bool
newtype IdeDefer = IdeDefer Bool
newtype IdeTesting = IdeTesting Bool
newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling Bool
data ProgressReportingStyle
= Percentage
| Explicit
| NoProgress
deriving ProgressReportingStyle -> ProgressReportingStyle -> Bool
(ProgressReportingStyle -> ProgressReportingStyle -> Bool)
-> (ProgressReportingStyle -> ProgressReportingStyle -> Bool)
-> Eq ProgressReportingStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgressReportingStyle -> ProgressReportingStyle -> Bool
== :: ProgressReportingStyle -> ProgressReportingStyle -> Bool
$c/= :: ProgressReportingStyle -> ProgressReportingStyle -> Bool
/= :: ProgressReportingStyle -> ProgressReportingStyle -> Bool
Eq
clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress
clientSupportsProgress :: ClientCapabilities -> IdeReportProgress
clientSupportsProgress ClientCapabilities
caps = Bool -> IdeReportProgress
IdeReportProgress (Bool -> IdeReportProgress) -> Bool -> IdeReportProgress
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
==
((\WindowClientCapabilities
x -> WindowClientCapabilities
x WindowClientCapabilities
-> Getting (Maybe Bool) WindowClientCapabilities (Maybe Bool)
-> Maybe Bool
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Bool) WindowClientCapabilities (Maybe Bool)
forall s a. HasWorkDoneProgress s a => Lens' s a
Lens' WindowClientCapabilities (Maybe Bool)
L.workDoneProgress) (WindowClientCapabilities -> Maybe Bool)
-> Maybe WindowClientCapabilities -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ClientCapabilities -> Maybe WindowClientCapabilities
LSP._window (ClientCapabilities
caps :: LSP.ClientCapabilities))
defaultIdeOptions :: Action IdeGhcSession -> IdeOptions
defaultIdeOptions :: Action IdeGhcSession -> IdeOptions
defaultIdeOptions Action IdeGhcSession
session = IdeOptions
{optPreprocessor :: ParsedSource -> IdePreprocessedSource
optPreprocessor = [(SrcSpan, String)]
-> [(SrcSpan, String)] -> ParsedSource -> IdePreprocessedSource
IdePreprocessedSource [] []
,optGhcSession :: Action IdeGhcSession
optGhcSession = Action IdeGhcSession
session
,optExtensions :: [String]
optExtensions = [String
"hs", String
"lhs"]
,optPkgLocationOpts :: IdePkgLocationOptions
optPkgLocationOpts = IdePkgLocationOptions
defaultIdePkgLocationOptions
,optShakeOptions :: ShakeOptions
optShakeOptions = ShakeOptions
shakeOptions
,optShakeProfiling :: Maybe String
optShakeProfiling = Maybe String
forall a. Maybe a
Nothing
,optReportProgress :: IdeReportProgress
optReportProgress = Bool -> IdeReportProgress
IdeReportProgress Bool
False
,optLanguageSyntax :: String
optLanguageSyntax = String
"haskell"
,optNewColonConvention :: Bool
optNewColonConvention = Bool
False
,optKeywords :: [Text]
optKeywords = [Text]
haskellKeywords
,optDefer :: IdeDefer
optDefer = Bool -> IdeDefer
IdeDefer Bool
True
,optTesting :: IdeTesting
optTesting = Bool -> IdeTesting
IdeTesting Bool
False
,optCheckProject :: IO Bool
optCheckProject = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
,optCheckParents :: IO CheckParents
optCheckParents = CheckParents -> IO CheckParents
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CheckParents
CheckOnSave
,optHaddockParse :: OptHaddockParse
optHaddockParse = OptHaddockParse
HaddockParse
,optModifyDynFlags :: Config -> DynFlagsModifications
optModifyDynFlags = Config -> DynFlagsModifications
forall a. Monoid a => a
mempty
,optSkipProgress :: forall a. Typeable a => a -> Bool
optSkipProgress = a -> Bool
forall a. Typeable a => a -> Bool
defaultSkipProgress
,optProgressStyle :: ProgressReportingStyle
optProgressStyle = ProgressReportingStyle
Explicit
,optRunSubset :: Bool
optRunSubset = Bool
True
,optVerifyCoreFile :: Bool
optVerifyCoreFile = Bool
False
,optMaxDirtyAge :: Int
optMaxDirtyAge = Int
100
}
defaultSkipProgress :: Typeable a => a -> Bool
defaultSkipProgress :: forall a. Typeable a => a -> Bool
defaultSkipProgress a
key = case () of
()
_ | Just GetFileContents
GetFileContents <- a -> Maybe GetFileContents
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
key -> Bool
True
()
_ | Just GetFileExists
GetFileExists <- a -> Maybe GetFileExists
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
key -> Bool
True
()
_ | Just GetModificationTime_{} <- a -> Maybe GetModificationTime
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
key -> Bool
True
()
_ -> Bool
False
data IdePkgLocationOptions = IdePkgLocationOptions
{ IdePkgLocationOptions -> UnitState -> Module -> IO (Maybe String)
optLocateHieFile :: UnitState -> Module -> IO (Maybe FilePath)
, IdePkgLocationOptions -> UnitState -> Module -> IO (Maybe String)
optLocateSrcFile :: UnitState -> Module -> IO (Maybe FilePath)
}
defaultIdePkgLocationOptions :: IdePkgLocationOptions
defaultIdePkgLocationOptions :: IdePkgLocationOptions
defaultIdePkgLocationOptions = (UnitState -> Module -> IO (Maybe String))
-> (UnitState -> Module -> IO (Maybe String))
-> IdePkgLocationOptions
IdePkgLocationOptions UnitState -> Module -> IO (Maybe String)
forall {m :: * -> *} {p} {p} {a}. Monad m => p -> p -> m (Maybe a)
f UnitState -> Module -> IO (Maybe String)
forall {m :: * -> *} {p} {p} {a}. Monad m => p -> p -> m (Maybe a)
f
where f :: p -> p -> m (Maybe a)
f p
_ p
_ = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
haskellKeywords :: [T.Text]
haskellKeywords :: [Text]
haskellKeywords =
[ Text
"as"
, Text
"case", Text
"of"
, Text
"class", Text
"instance", Text
"type"
, Text
"data", Text
"family", Text
"newtype"
, Text
"default"
, Text
"deriving"
, Text
"do", Text
"mdo", Text
"proc", Text
"rec"
, Text
"forall"
, Text
"foreign"
, Text
"hiding"
, Text
"if", Text
"then", Text
"else"
, Text
"import", Text
"qualified", Text
"hiding"
, Text
"infix", Text
"infixl", Text
"infixr"
, Text
"let", Text
"in", Text
"where"
, Text
"module"
]