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

-- | Options
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
    -- ^ Preprocessor to run over all parsed source trees, generating a list of warnings
    --   and a list of errors, along with a new parse tree.
  , IdeOptions -> Action IdeGhcSession
optGhcSession         :: Action IdeGhcSession
    -- ^ Setup a GHC session for a given file, e.g. @Foo.hs@.
    --   For the same 'ComponentOptions' from hie-bios, the resulting function will be applied once per file.
    --   It is desirable that many files get the same 'HscEnvEq', so that more IDE features work.
  , IdeOptions -> IdePkgLocationOptions
optPkgLocationOpts    :: IdePkgLocationOptions
    -- ^ How to locate source and @.hie@ files given a module name.
  , IdeOptions -> [String]
optExtensions         :: [String]
    -- ^ File extensions to search for code, defaults to Haskell sources (including @.hs@)
  , IdeOptions -> Maybe String
optShakeProfiling     :: Maybe FilePath
    -- ^ Set to 'Just' to create a directory of profiling reports.
  , IdeOptions -> IdeTesting
optTesting            :: IdeTesting
    -- ^ Whether to enable additional lsp messages used by the test suite for checking invariants
  , IdeOptions -> IdeReportProgress
optReportProgress     :: IdeReportProgress
    -- ^ Whether to report progress during long operations.
  , IdeOptions -> Int
optMaxDirtyAge        :: Int
    -- ^ Age (in # builds) at which we collect dirty keys
  , IdeOptions -> String
optLanguageSyntax     :: String
    -- ^ the ```language to use
  , IdeOptions -> Bool
optNewColonConvention :: Bool
    -- ^ whether to use new colon convention
  , IdeOptions -> [Text]
optKeywords           :: [T.Text]
    -- ^ keywords used for completions. These are customizable
    -- since DAML has a different set of keywords than Haskell.
  , IdeOptions -> IdeDefer
optDefer              :: IdeDefer
    -- ^ Whether to defer type errors, typed holes and out of scope
    --   variables. Deferral allows the IDE to continue to provide
    --   features such as diagnostics and go-to-definition, in
    --   situations in which they would become unavailable because of
    --   the presence of type errors, holes or unbound variables.
  , IdeOptions -> IO Bool
optCheckProject       :: IO Bool
    -- ^ Whether to typecheck the entire project on load
  , IdeOptions -> IO CheckParents
optCheckParents       :: IO CheckParents
    -- ^ When to typecheck reverse dependencies of a file
  , IdeOptions -> OptHaddockParse
optHaddockParse       :: OptHaddockParse
    -- ^ Whether to return result of parsing module with Opt_Haddock.
    --   Otherwise, return the result of parsing without Opt_Haddock, so
    --   that the parsed module contains the result of Opt_KeepRawTokenStream,
    --   which might be necessary for hlint.
  , IdeOptions -> Config -> DynFlagsModifications
optModifyDynFlags     :: Config -> DynFlagsModifications
    -- ^ Will be called right after setting up a new cradle,
    --   allowing to customize the Ghc options used
  , IdeOptions -> ShakeOptions
optShakeOptions       :: ShakeOptions
  , IdeOptions -> forall a. Typeable a => a -> Bool
optSkipProgress       :: forall a. Typeable a => a -> Bool
      -- ^ Predicate to select which rule keys to exclude from progress reporting.
  , IdeOptions -> ProgressReportingStyle
optProgressStyle      :: ProgressReportingStyle
  , IdeOptions -> Bool
optRunSubset          :: Bool
      -- ^ Experimental feature to re-run only the subset of the Shake graph that has changed
  , IdeOptions -> Bool
optVerifyCoreFile     :: Bool
    -- ^ Verify core files after serialization
  }

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)]
    -- ^ Warnings emitted by the preprocessor.
  , IdePreprocessedSource -> [(SrcSpan, String)]
preprocErrors   :: [(GHC.SrcSpan, String)]
    -- ^ Errors emitted by the preprocessor.
  , IdePreprocessedSource -> ParsedSource
preprocSource   :: GHC.ParsedSource
    -- ^ New parse tree emitted by the preprocessor.
  }

newtype IdeReportProgress    = IdeReportProgress Bool
newtype IdeDefer             = IdeDefer          Bool
newtype IdeTesting           = IdeTesting        Bool
newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling    Bool

data ProgressReportingStyle
    = Percentage -- ^ Report using the LSP @_percentage@ field
    | Explicit   -- ^ Report using explicit 123/456 text
    | NoProgress -- ^ Do not report any percentage
    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
    -- don't do progress for GetFileContents as it's cheap
    ()
_ | Just GetFileContents
GetFileContents <- a -> Maybe GetFileContents
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
key        -> Bool
True
    -- don't do progress for GetFileExists, as there are lots of redundant nodes
    -- (normally there is one node per file, but this is not the case for GetFileExists)
    ()
_ | Just GetFileExists
GetFileExists <- a -> Maybe GetFileExists
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
key          -> Bool
True
    -- don't do progress for GetModificationTime as there are lot of redundant nodes
    -- (for the interface files)
    ()
_ | Just GetModificationTime_{} <- a -> Maybe GetModificationTime
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
key -> Bool
True
    ()
_                                           -> Bool
False


-- | The set of options used to locate files belonging to external packages.
data IdePkgLocationOptions = IdePkgLocationOptions
  { IdePkgLocationOptions -> UnitState -> Module -> IO (Maybe String)
optLocateHieFile :: UnitState -> Module -> IO (Maybe FilePath)
  -- ^ Locate the HIE file for the given module. The PackageConfig can be
  -- used to lookup settings like importDirs.
  , IdePkgLocationOptions -> UnitState -> Module -> IO (Maybe String)
optLocateSrcFile :: UnitState -> Module -> IO (Maybe FilePath)
  -- ^ Locate the source file for the given module. The PackageConfig can be
  -- used to lookup settings like importDirs. For DAML, we place them in the package DB.
  -- For cabal this could point somewhere in ~/.cabal/packages.
  }

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

-- | From https://wiki.haskell.org/Keywords
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"
  ]