{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
module Development.IDE.Types.Options
( IdeOptions(..)
, IdePreprocessedSource(..)
, IdeReportProgress(..)
, IdeDefer(..)
, IdeTesting(..)
, clientSupportsProgress
, IdePkgLocationOptions(..)
, defaultIdeOptions
, IdeResult
, IdeGhcSession(..)
, LspConfig(..)
, defaultLspConfig
, CheckProject(..)
, CheckParents(..)
, OptHaddockParse(..)
) where
import Development.Shake
import Development.IDE.GHC.Util
import GHC hiding (parseModule, typecheckModule)
import GhcPlugins as GHC hiding (fst3, (<>))
import qualified Language.Haskell.LSP.Types.Capabilities as LSP
import qualified Data.Text as T
import Development.IDE.Types.Diagnostics
import Control.DeepSeq (NFData(..))
import Data.Aeson
import GHC.Generics
data IdeGhcSession = IdeGhcSession
{ loadSessionFun :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
, sessionVersion :: !Int
}
instance Show IdeGhcSession where show _ = "IdeGhcSession"
instance NFData IdeGhcSession where rnf !_ = ()
data IdeOptions = IdeOptions
{ optPreprocessor :: GHC.ParsedSource -> IdePreprocessedSource
, optGhcSession :: Action IdeGhcSession
, optPkgLocationOpts :: IdePkgLocationOptions
, optExtensions :: [String]
, optThreads :: Int
, optShakeFiles :: Maybe FilePath
, optShakeProfiling :: Maybe FilePath
, optTesting :: IdeTesting
, optReportProgress :: IdeReportProgress
, optLanguageSyntax :: String
, optNewColonConvention :: Bool
, optKeywords :: [T.Text]
, optDefer :: IdeDefer
, optCheckProject :: CheckProject
, optCheckParents :: CheckParents
, optHaddockParse :: OptHaddockParse
, optCustomDynFlags :: DynFlags -> DynFlags
}
data OptHaddockParse = HaddockParse | NoHaddockParse
deriving (Eq,Ord,Show,Enum)
newtype CheckProject = CheckProject { shouldCheckProject :: Bool }
deriving stock (Eq, Ord, Show)
deriving newtype (FromJSON,ToJSON)
data CheckParents
= NeverCheck
| CheckOnClose
| CheckOnSaveAndClose
| AlwaysCheck
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass (FromJSON, ToJSON)
data LspConfig
= LspConfig
{ checkParents :: CheckParents
, checkProject :: CheckProject
} deriving stock (Eq, Ord, Show, Generic)
deriving anyclass (FromJSON, ToJSON)
defaultLspConfig :: LspConfig
defaultLspConfig = LspConfig CheckOnSaveAndClose (CheckProject True)
data IdePreprocessedSource = IdePreprocessedSource
{ preprocWarnings :: [(GHC.SrcSpan, String)]
, preprocErrors :: [(GHC.SrcSpan, String)]
, preprocSource :: GHC.ParsedSource
}
newtype IdeReportProgress = IdeReportProgress Bool
newtype IdeDefer = IdeDefer Bool
newtype IdeTesting = IdeTesting Bool
clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress
clientSupportsProgress caps = IdeReportProgress $ Just True ==
(LSP._workDoneProgress =<< LSP._window (caps :: LSP.ClientCapabilities))
defaultIdeOptions :: Action IdeGhcSession -> IdeOptions
defaultIdeOptions session = IdeOptions
{optPreprocessor = IdePreprocessedSource [] []
,optGhcSession = session
,optExtensions = ["hs", "lhs"]
,optPkgLocationOpts = defaultIdePkgLocationOptions
,optThreads = 0
,optShakeFiles = Nothing
,optShakeProfiling = Nothing
,optReportProgress = IdeReportProgress False
,optLanguageSyntax = "haskell"
,optNewColonConvention = False
,optKeywords = haskellKeywords
,optDefer = IdeDefer True
,optTesting = IdeTesting False
,optCheckProject = checkProject defaultLspConfig
,optCheckParents = checkParents defaultLspConfig
,optHaddockParse = HaddockParse
,optCustomDynFlags = id
}
data IdePkgLocationOptions = IdePkgLocationOptions
{ optLocateHieFile :: PackageConfig -> Module -> IO (Maybe FilePath)
, optLocateSrcFile :: PackageConfig -> Module -> IO (Maybe FilePath)
}
defaultIdePkgLocationOptions :: IdePkgLocationOptions
defaultIdePkgLocationOptions = IdePkgLocationOptions f f
where f _ _ = return Nothing
haskellKeywords :: [T.Text]
haskellKeywords =
[ "as"
, "case", "of"
, "class", "instance", "type"
, "data", "family", "newtype"
, "default"
, "deriving"
, "do", "mdo", "proc", "rec"
, "forall"
, "foreign"
, "hiding"
, "if", "then", "else"
, "import", "qualified", "hiding"
, "infix", "infixl", "infixr"
, "let", "in", "where"
, "module"
]